Este relatório apresenta a análise de uma base de dados abertos utilizando a metodologia de Descoberta de Conhecimento em Bases de Dados. Através da base de dados disponibilizados pela Polícia Rodoviária Federal, disponibilizamos código para realizar cada etapa e discutimos os resultados encontrados. Utilizando a linguagem de programação R, com auxílio da IDE RStudio, construímos esta análise com intuito de disponibilizar material que mostre as tarefas necessárias para aplicar a descoberta de conhecimento.
Buscando maximizar o alcance do conhecimento gerado, relatamos os resultados deste projeto através de diversas plataformas. Esta página web que você atualmente está lendo se encontra disponível no Github, contendo grande parte do código, textos e gráficos gerados. Por último, para quem desejar reproduzir o estudo, disponibilizamos um repositório que contém o documento que contém o código, em formato R-Markdown, além dos arquivos utilizados para executar o código, no Github dos autores.
Neste relatório utiliza-se os dados abertos fornecidos pela Polícia Rodoviária Federal (PRF) para aplicar métodos de análise de dados sobre os conjuntos de dados de acidentes agrupados por pessoas referente aos anos de 2017 até 2019. Busca-se a melhor compreensão dos dados, gerando um conhecimento útil através da aplicação de técnicas de descoberta de conhecimento.
O escopo deste trabalho envolve analisar as bases de dados, realizar a compreensão dos dados brutos, realizar toda a fase de pré-procesamento, até chegar na elaboração de perfis de acidentados. Os resultados são obtidos com aplicação de Regras de Associação, através da comparação das regras geradas.
Os dados foram obtidos através do site da Polícia Rodoviária Federal na seção de dados abertos na categoria de acidentes (Polícia Rodoviária Federal 2020). Os conjuntos de dados selecionados são referentes a acidentes agrupados por pessoas nos anos de 2017, 2018 e 2019. O motivo por escolher a base agrupada por pessoas foi que ao analisar inicialmente todas as bases de 2017, esta apresenta se com maior quantidade de atributos, os quais permitem uma análise mais profunda sobre os detalhes do acidente.
Ao acessar a página, a primeira duvida que surge é utilizar a base de dados com todas as causas e tipos de acidente ou utilizar a agrupada por pessoas simples. Com uma breve análise, encontramos que a principal diferença entre as duas bases é que a base com todas as causas e tipos possui dois atributos adicionais. O primeiro atributo é chamado de “causa_principal” e ele diz se o valor do atributo “causa_acidente” foi o principal motivo causador identificado pelo policial. Para os registros de uma determinada pessoa que se envolveu em um acidente, caso duas causas forem identificadas por um policial, haverá então dois registros para cada pessoa envolvida naquele acidente, um com o motivo principal e “causa_principal” identificado “sim”, e outro costando “não” com o motivo secundário.
O segundo atributo é chamado de “ordem_tipo_acidente”, que identifica em qual ordem o tipo_acidente ocorreu. Logo, para uma pessoa em um carro que primeiro colidiu, depois capotou, haverá duas instâncias, com o número “1” constando como o primeiro valor de “ordem_tipo_acidente” e o tipo “Colisão”, e depois “2” como ordem, e “Capotamento” como o segundo tipo.
Em ambos exemplos, vemos que ocorre uma duplicação dos registros por pessoa, e a base de dados pode se tornar complexa para ser analisada, além de redundante. Por isso, optamos por usar a versão simples, que não possui essas duplicações, e tem dados disponíveis desde 2007.
O dicionário de dados agrupados por pessoas a partir de 2017, foi utilizado para auxiliar na interpretação dos dados. A disponibilização de um dicionário de dados torna o processo de interpretação inicial mais fácil, porém, pretendemos realizar uma análise aprofundada para esclarecer detalhes que o dicionário de dados não traz. Os dados são fornecidos em formato “.csv” e o dicionário em formato “.pdf”.
Após obter os três arquivos contendo os acidentes agrupados por pessoas referentes aos anos de 2017, 2018 e 2019, eles devem ser importados no RStudio. Utilizamos a função de importação nativa para carregar as três bases para o ambiente do RStudio. Ao criar um novo projeto no RStudio, pode se adicionar um arquivo de script onde é possível definir uma lista de comandos. Primeiro, utilizando a função “setwd()” deve se definir o diretório onde se encontra os arquivos a serem carregados. Note que o diretório deve estar entre aspas, e utilizar barra, e não contra barra como alguns sistemas operacionais utilizam.
Então, a função “read.csv()” pode ser chamada, e usada para ler e atribuir a base para uma variável de data frame. Três parâmetros foram utilizados, um para definir o separador utilizado no arquivo “.csv”, o segundo para definir as strings que devem ser importadas e sobrescritas como valores ausentes, e o terceiro é o método de encoding utilizado no arquivo.
setwd("C:/Analise PRF 2020/Base de Dados")
dados2017 <- read.csv(file='acidentes2017.csv',
sep=";",
na.strings = c("NA",""," ","Não Informado"),
encoding ="ISO-8859-1")No início deste estudo, foi encontrado um problema em que os valores textuais das tabelas possuíam espaços ou tabs nos seus finais. O problema que esses espaços geravam é que ao tentar comparar valores para realizar buscas, apesar do texto parecer ser idêntico, de fato, a falta dos espaços na busca, retornava um resultado em que o valor não foi encontrado. Demonstramos isto no próximo chunk de código.
## [1] TRUE
## [1] FALSE
A existência do problema pode ser confirmada utilizando um leitor de texto para abrir o arquivo, onde é mais fácil perceber os espaços. A utilização da função de importação de csv “read_csv2()” da biblioteca readr auxiliou em remover estes espaços. Notamos que o problema provavelmente surgiu utilizando ferramentas de visualização de tabelas, que provavelmente alteraram os valores dos dados, inserindo estes espaços para melhorar a visualização dos dados.
Devido a ferramenta de trabalho que está sendo utilizada, trabalhar com as três bases separadas não traz muitas dificuldades, mas é necessário verificar que todas as colunas das três bases diferentes possuem colunas que representam os mesmos tipos de dados. É possível inferir que isso é verdade, pois a Polícia Rodoviária Federal fornece um único dicionário de dados para estas três bases diferentes. Mesmo assim, por questão de rigor, gostaríamos de verificar que isto é verdade. Outro motivo por realizar esta verificação, é que ao trabalhar com uma base mais antiga, o número de colunas não eram iguais então achamos interessante verificar para ter certeza que com os dados atualizados tudo estaria certo.
Primeiro, podemos verificar que as tabelas possuem a mesma quantidade de colunas. A função “ncol()” retorna isto. Logo abaixo, mostramos seu funcionamento.
## [1] 35
## [1] 35
## [1] 35
Utilizando a função “row_names()” geramos tabelas que especificam o nome das colunas. Estas três tabelas foram unidas em uma única só com a função “data.frame()”. O resultado se encontra na tabela a baixo, note que todas contêm os mesmos nomes nas linhas, então, correspondem ao mesmo tipo de informação e são compatíveis.
Com base na tabela, podemos concluir então que os dados são compatíveis para realizar a união. Para fazer isto, a função “rbind()” permite unir dois data frames adicionando as linhas. A função “cbind()” faz algo similar, porém com as colunas. A seguir temos uma demonstração, onde unimos todos os nossos dados em um único data frame. Para conferir que tudo ocorreu corretamente, verificamos a igualdade da soma do número de linhas de cada data frame com a união destes data frame.
dados <- rbind(dados2017,dados2018,dados2019)
nrow(dados) == nrow(dados2017) + nrow(dados2018) + nrow(dados2019)## [1] TRUE
Após ter corretamente importado nossa base de dados, e verificar que é possível unir tudo em um único data frame, é necessário começar analisar individualmente o que podemos encontrar em nossa base e o que cada atributo representa. Para esta tarefa, primeiro realizamos um breve estudo sobre a dimensão dos dados apresentados e o que eles significam. Depois, elaboramos uma função que gera um data frame que resume várias características para cada coluna de um data frame. Então, nós aplicamos a função e destacamos alguns detalhes que podem ser concluídos interpretando seus resultados.
Em primeiro lugar, achamos interessante expressar de forma gráfica o tamanho do dataset, para que fique mais claro como o conjunto de dados evoluiu ao longo dos anos. Neste tópico será analisado a evolução do: numero de acidentes por ano; número de veículos acidentados e número de pessoas envolvidas em acidentes.
O número de acidentes por ano pode ser contabilizado identificado o número de vezes que cada identificador de acidente ocorre por ano. Realizamos esta tarefa criando um data frame que armazena o número de identificadores distintos encontrados no atributo “id” para cada ano que temos. Como o “id” não possui valores ausentes (ver seção sobre resumo de atributos), podemos fazer desta forma.
contPessoas <- data.frame(ano = c(2017,2018,2019),
nAcidentes = c(length(levels(as.factor(dados2017$id))),
length(levels(as.factor(dados2018$id))),
length(levels(as.factor(dados2019$id)))))DT::datatable(contPessoas,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))Como o identificador de veículos possui apenas valores ausentes para a tabela referente aos dados de 2017 e a quantidade de valores ausentes é muito pequena, podemos construir uma coluna similar ao número de acidentes. Primeiro, podemos conferir que todos os valores ausentes pertencem ao mesmo acidente com a função “is.na()” e verificar que todos veículos pertencem ao mesmo acidente, podendo então assumir “1” veículo sem identificador por acidente.
# Pega instancias com id veiculo = NA
y <- dados2017[is.na(dados2017$id_veiculo),]
# Calcula quantos acidentes individuasi tem nessas instancias
nSemId <- length(levels(as.factor(y$id)))
# Cria uma nova coluna vazia
contPessoas$nVeiculos <- NA
# Preeche linhas da nova coluna - Subtrai valores ausentes
contPessoas$nVeiculos[1] <- length(levels(as.factor(dados2017$id_veiculo)))
contPessoas$nVeiculos[1] <- contPessoas$nVeiculos[1] - nSemId
contPessoas$nVeiculos[2] <- length(levels(as.factor(dados2018$id_veiculo)))
contPessoas$nVeiculos[3] <- length(levels(as.factor(dados2019$id_veiculo)))Como a tabela é por pessoas, para encontrar o número de acidentados é simples. Cada pessoa é associada a um único registro, por tanto, a quantidade de registros por data frame (calculado com a função “nrow()”), é a quantidade de pessoas envolvidas em acidentes naquele ano.
# Inicia nova coluna vazia
contPessoas$nPessoas <- NA
# Preeche linhas da nova coluna
contPessoas$nPessoas[1] <- nrow(dados2017)
contPessoas$nPessoas[2] <- nrow(dados2018)
contPessoas$nPessoas[3] <- nrow(dados2019)A partir do data frame gerado plotamos três gráficos que contabilizam o numero de pessoas acidentes, veículos envolvidos em acidentes e numero de acidentes.
# Preprocessando o data frame para criar o grafico
aux1 <- contPessoas
aux1$ano<-factor(aux1$ano)
aux1$ano <- factor(aux1$ano, levels=rev(levels(aux1$ano)))
aux1$nAcidentes<-factor(aux1$nAcidentes)
aux1$nVeiculos<-factor(aux1$nVeiculos)
aux1$nPessoas<-factor(aux1$nPessoas)
## Grafico de Frequencia de acidentes por ano
p1 <- ggplot(aux1, aes(x = ano, y = nAcidentes)) +
geom_bar(stat = "identity", aes(fill = ano)) +
ggtitle("a) Número de acidentes entre 2017 e 2019") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1, tooltip = c("colour"))## Grafico de Frequencia de veiculos acidentadas por Ano
p2 <- ggplot(aux1, aes(x = ano, y = nVeiculos)) +
geom_bar(stat = "identity", aes(fill = ano)) +
ggtitle("b) Veículos acidentados por ano entre 2017 e 2019") +
xlab("Ano") +
ylab("Veículos") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p2,tooltip = c("colour"))## Grafico de Frequencia de pessoas acidentadas por Ano
p3 <- ggplot(aux1, aes(x = ano, y = nPessoas)) +
geom_bar(stat = "identity", aes(fill = ano)) +
ggtitle("c) Pessoas acidentadas por ano entre 2017 e 2019") +
xlab("Ano") +
ylab("Pessoas") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p3,tooltip = c("colour"))É interessante realizar uma análise inicial do conteúdo da tabela. Para isto, foi definida uma função chamada “resumoDados()” com base na proposta de Pearson (Ronald K. Pearson 2018, Cap. 7, pp.279). Além de alterar o nome das variáveis para nomes mais claros, permitimos decidir quantas casas após a vírgula devem ser utilizadas. Apenas dois parâmetros são aceitos, primeiro o data frame para ser avaliado, e depois o número de dígitos de precisão (casas decimais após o primeiro digito - pode variar devido as definições de notação cientifica) para realizar os cálculos de proporção, este ultimo sendo opcional, com valor padrão de 4 dígitos.
A saída do algoritmo gera um data frame (N,8) onde o N é o numero de linhas, e varia com a quantidade de colunas com base no data frame de entrada. As 8 colunas geradas são informações geradas a partir do processamento das observações dentro do data frame de entrada. As 8 colunas geradas são descritas a baixo:
Atributo: Diz a qual atributo do data frame original que esta linha se refere.
Tipo: Descreve o tipo de dado (Com base nos tipos primitivos do R) que se encontra nos registros deste atributo.
Niveis: Calculado através da função “levels()”, identifica o numero de valores distintos encontrados neste atributo quando ele foi transformado em factor. A função “levels()” funciona apenas com factors, e por isto os dados são transformados.
modaNíveis: Identifica qual nível ocorreu mais vezes dentre todos os outros para este atributo.
quantModa: Diz quantas vezes o nível que ocorreu mais vezes ocorreu dentro do dataframe original.
fracMax: Calcula a porcentagem em que o nível que mais ocorreu corresponde em relação aos outros níveis do atributo.
nAusente: Diz quantas vezes valores foram registrados como ausentes ou não informados dentro do dataset.
fracAusente: Calcula a porcentagem em que os valores ausentes foram encontrados em relação aos outros níveis.
# ENTRADAS: Data frame para analise, numero de digitos significativos
# SAIDAS: Data frame contendo resumo do data frame de entrada
resumoDados <- function(frameDados,ndig = 4){
# Quantidade de atributos existentes dentro da estrutura
nAtribs <- ncol(frameDados)
# Criacao da coluna de nome de atributos
nomeAtrib <- colnames(frameDados)
# Criacao da coluna de tipo de atributos
tipoAtrib <- vector("character",nAtribs)
# Criacao da coluna do valor mais comum dentro de um atributo
modaNiveis <- vector("character",nAtribs)
# Criacao da coluna da quantidade existente do level mais comum
quantModa <- vector("numeric",nAtribs)
# Coluna para identificar a quantidade de valores NAs no atributo
nAusente <- vector("numeric",nAtribs)
# Criacao da coluna para armazenar os levels
levels <- vector("numeric", nAtribs)
for (i in 1:nAtribs){
x <- frameDados[,i] # Pega toda a coluna
tipoAtrib[i] <- class(x) # Analisa a classe da coluna atual
# Se nao for numerico eh transformador em factor
if(class(x) != "numeric" & class(x) != "factor"){
x <- as.character(x)
x <- as.factor(x)
}
# Cria uma tabela de contabilizacao de valores NA positivos
xtab <- table(x, useNA = "ifany")
# A quantidade de niveis eh o tamanho da tabela de contabilizacao
levels[i] <- length(xtab)
# Representacao numerica dos niveis
nums <- as.numeric(xtab)
# Nivel que mais se repete
maxnum <- max(nums)
# Define na tabela o nivel que mais se repete
quantModa[i] <- maxnum
# Pega o indice do que mais se repete
maxIndex <- which.max(nums)
# Define o nome dos valores numerico dos niveis
lvls <- names(xtab)
# Coloca na tabela o indice que mais se repete
modaNiveis[i] <- lvls[maxIndex]
if(is.na(modaNiveis[i])){
modaNiveis[i] <- "NA"
}
# Cria um vetor que contem todos valores ausentes
missIndex <- which((is.na(x)))
# Quantidade de NA eh o tamanho da definicao anterior
nAusente[i] <- length(missIndex)
}
# Contabiliza a quantdade total de instancias para o atributo
instTotal <- nrow(frameDados)
# Calcula proporcao de mais comum para total
fracMax <- as.factor(signif(quantModa/instTotal,ndig))
# Calcula proporcao de ausente para total
fracAusente <- as.factor(signif(nAusente/instTotal,ndig))
frameDadosResumidos <- data.frame(Atributo = nomeAtrib,
Tipo = tipoAtrib,
Niveis = levels,
modaNiveis = modaNiveis,
quantModa = as.factor(quantModa),
fracMax = as.factor(fracMax),
nAusente = as.factor(nAusente),
fracAusente = as.factor(fracAusente))
row.names(frameDadosResumidos) <- NULL
return(frameDadosResumidos)
}Referente aos dados de 2017, o que achamos interessante destacar é a quantidade de pessoas com idade, sexo, estado físico, traçado da via, tipo de envolvimento e informações sobre o veículo ausentes. Pela coluna de “modaNiveis” podemos construir uma idéia básica dos principais motivos e características de acidentes, de forma não relacionada entre si.
Notamos que apesar do estado de Minas Gerais ser o que mais apresenta acidentes, o município de Curitiba, em São Paulo, demonstrou o maior numero de acidentes em uma única cidade. Pode se destacar também que a maioria dos acidentes ocorrem nos domingos, e o horário que mais consta acidentes é as 18:00h. Sobre os acidentes em si, a maior causa é falta de atenção à condução que neste ano correspondeu a quase 40% das causas de acidentes.
Sobre o perfil dos acidentados, a maioria são do sexo masculino (mais de 70%) e são condutores. Metade dos casos registrados são de pessoas que saem ilesas. Através do identificador de acidentes, podemos concluir que o maior acidente (em relação a numero de envolvidos) envolveu 75 pessoas.
A mesma análise foi repetida, agora com base nos dados de 2018. Mais uma vez, as colunas de idade, traçado da via, sexo, estado físico e informações sobre os veículos apresentam uma alta quantidade de dados ausentes.
Novamente, podemos construir uma idéia de fatores recorrentes em grandes números de acidentes. O perfil no geral dos fatores que mais se repetem em acidentes se manteve como no ano de 2017. O acidente com maior número pessoas envolvidas cresceu.
Novamente a análise foi repetida, desta vez com base nos dados de 2019. Referente a dados ausentes, podemos perceber um padrão consiste em atributos que apresentam altos valores de dados ausentes: Informações sobre o veículo, Traçado da via, estado físico, idade e sexo.
Neste ano, Brasília tomou o lugar de Curitiba como cidade que mais possui registros de acidentes, e os demais atributos se mantiveram. Neste ano, o acidente com maior número de pessoas diminuiu para 74 envolvidos.
Executamos a função para se ter uma noção completa da base de dados que temos ao dispor. A análise dos identificadores deixa de ser válida para este data frame pois os identificadores se repetem todo ano, mas representam acidentes diferentes.
Neste tópico analisamos individualmente os atributos e documentamos as conclusões a partir da análise, buscando preparar os atributos para a mineração de regras de associação para construção de perfis.
Há três tipos de identificadores no dataset, cada um com uma funcionalidade. Uma análise sobre a quantidade e distribuição dos identificadores já foi feita na seção sobre Análise de dimensões do dataset, porém vamos procurar trabalhar mais com estes atributos nesta seção. Para a aplicação de técnicas de mineração de dados, não foi notado nenhuma informação útil que estes atributos poderiam fornecer (com os objetivos que foram estabelecidos), logo provavelmente não serão utilizados na aplicação de algoritmos.
Mesmo assim, esses atributos são úteis para a etapa de análise exploratória, permitindo identificador casos individuais, e destacar quantidades de acidentes, veículos e pessoas, além de observar como essas quantidades se comportam. Os valores destes atributos mostram que devido a existência de saltos de valores de identificadores, provavelmente há casos de registros ocultos ou apagados.
Este identificador é denotado pelo atributo “id”. A sua função consiste em diferenciar diferentes ocorrências de acidentes. Cada valor de “id” corresponde a um acidente diferente. Este atributo é numérico, e pode ser como um atributo para filtro quando for desejado analisar um único acidente. Conforme analisado na seção sobre. Ao longo dos três anos, este identificador não possui nenhum valor ausente.
Na base de dados, cada veículo recebe um identificador único denotado por “id_veiculo”. Desta forma, é possível diferenciar veículos envolvidos em um acidente. Com este atributo, é possível identificar por exemplo o número de veículos envolvidos por acidente. Como seria difícil visualizar isto, além de contabilizar a quantidade de veículos por acidente, contabilizamos quantas vezes cada quantidade se repete. Desta forma, temos um data frame sobre o número de veículos por acidentes, e quantas vezes esse número de veículos ocorreu em um acidente no nosso conjunto de dados.
As três figuras abaixo demonstram um comportamento interessante ao passar dos anos. A quantidade de acidentes registrados envolvendo um único veículo diminuiu significativamente no ano de 2018. É valido considerar que algo possa ter mudado para gerar valores tão diferentes de um ano para outro. Não conseguimos afirmar certamente o que mudou, talvez as pessoas começaram prestar mais atenção, ou então talvez a Polícia Rodoviária Federal teve alguma mudança na sua política de registro de acidentes. Houve também uma queda nos acidentes que envolvem dois veículos em 2018, mas o valor se manteve em 2019.
# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(id = dados2017$id,id_veiculo = dados2017$id_veiculo)
# Deixando so os veiculos nao repetidos
aux1 <- aux1[!duplicated(aux1$id_veiculo),]
# Contando quantos veiculos por acidente
aux1 <- as.data.frame(table(aux1$id))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "quantVeiculos"
aux1 <- as.data.frame(table(aux1$quantVeiculos))
names(aux1)[names(aux1) == "Var1"] <- "veiculosEnvolvidos"
names(aux1)[names(aux1) == "Freq"] <- "acidentesRegistrados"## Grafico de Frequencia de veiculos acidentadas por Ano
p1 <- ggplot(aux1, aes(x = veiculosEnvolvidos, y = acidentesRegistrados)) +
geom_bar(stat = "identity", aes(fill = veiculosEnvolvidos)) +
ggtitle("a) Acidentes por quantidade de veículos envolvidos (2017)") +
xlab("Veículos envolvidos") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(id = dados2018$id,id_veiculo = dados2018$id_veiculo)
# Deixando so os veiculos nao repetidos
aux1 <- aux1[!duplicated(aux1$id_veiculo),]
# Contando quantos veiculos por acidente
aux1 <- as.data.frame(table(aux1$id))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "quantVeiculos"
aux1 <- as.data.frame(table(aux1$quantVeiculos))
names(aux1)[names(aux1) == "Var1"] <- "veiculosEnvolvidos"
names(aux1)[names(aux1) == "Freq"] <- "acidentesRegistrados"## Grafico de Frequencia de veiculos acidentadas por Ano
p2 <- ggplot(aux1, aes(x = veiculosEnvolvidos, y = acidentesRegistrados)) +
geom_bar(stat = "identity", aes(fill = veiculosEnvolvidos)) +
ggtitle("b) Acidentes por quantidade de veículos envolvidos (2018)") +
xlab("Veículos envolvidos") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p2)# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(id = dados2019$id,id_veiculo = dados2019$id_veiculo)
# Deixando so os veiculos nao repetidos
aux1 <- aux1[!duplicated(aux1$id_veiculo),]
# Contando quantos veiculos por acidente
aux1 <- as.data.frame(table(aux1$id))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "quantVeiculos"
aux1 <- as.data.frame(table(aux1$quantVeiculos))
names(aux1)[names(aux1) == "Var1"] <- "veiculosEnvolvidos"
names(aux1)[names(aux1) == "Freq"] <- "acidentesRegistrados"## Grafico de Frequencia de veiculos acidentadas por Ano
p3 <- ggplot(aux1, aes(x = veiculosEnvolvidos, y = acidentesRegistrados)) +
geom_bar(stat = "identity", aes(fill = veiculosEnvolvidos)) +
ggtitle("c) Acidentes por quantidade de veículos envolvidos (2019)") +
xlab("Veículos envolvidos") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p3)O terceiro e último identificador na base de dados é chamado de “pesid”. Ele é utilizado para identificar unicamente uma pessoa acidentada. Apesar de parecer inútil, na base de dados completa (com todas as causas), há casos de pessoas com múltiplos registros na base de dados. Entretanto, para os fins planejados, este atributo possui pouca (ou nenhuma) significância.
Similar ao caso anterior, podemos analisar a quantidade de pessoas envolvidas por acidente, ou até mesmo, a quantidade de pessoas envolvidas por veículo. Desta vez, por questão de simplicidade, apenas o data frame com as quantidades será mostrado.
Notamos desta vez que o número de veículos registrados com apenas uma pessoa caiu significativamente em 2018. Os outros registros também caíram em 2018, mas não de forma tão significativa. Isto vem para reforçar a nossa idéia que por algum motivo, acidentes que envolveram só uma pessoa/veículo caiu em número de registros.
# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(pesid = dados2017$pesid,id_veiculo = dados2017$id_veiculo)
# Contando quantos pessoas por acidente
aux1 <- data.frame(table(aux1$id_veiculo))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "pessoas"
aux1 <- data.frame(table(aux1$pessoas))
names(aux1)[names(aux1) == "Var1"] <- "Pessoas no veículo"
names(aux1)[names(aux1) == "Freq"] <- "Numero de veículos registrados"
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(pesid = dados2018$pesid,id_veiculo = dados2018$id_veiculo)
# Contando quantos pessoas por acidente
aux1 <- as.data.frame(table(aux1$id_veiculo))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "pessoas"
aux1 <- data.frame(table(aux1$pessoas))
names(aux1)[names(aux1) == "Var1"] <- "Pessoas no veículo"
names(aux1)[names(aux1) == "Freq"] <- "Numero de veículos registrados"
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))# Pegando so o identificador de acidente, e o de veiculo
aux1 <- data.frame(pesid = dados2019$pesid,id_veiculo = dados2019$id_veiculo)
# Contando quantos pessoas por acidente
aux1 <- as.data.frame(table(aux1$id_veiculo))
## Contando quantas vezes a quantidade de veiculos por acidente se repetiu
names(aux1)[names(aux1) == "Freq"] <- "pessoas"
aux1 <- data.frame(table(aux1$pessoas))
names(aux1)[names(aux1) == "Var1"] <- "Pessoas no veículo"
names(aux1)[names(aux1) == "Freq"] <- "Numero de veículos registrados"
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))A seguir elaboramos um data frame para analisar medidas de tendência central de pessoas e veículos envolvidos em acidentes. Na aba de veículos, os cálculos referentes a medidas de tendência central são de veículos por acidente. Na aba de pessoas, os cálculos são referentes a de pessoas por acidente.
# Pegando so o identificador de acidente, e o de veiculo e deixando só os veiculos não repetidos para 2017
aux1 <- data.frame(id = dados2017$id,id_veiculo = dados2017$id_veiculo)
aux1 <- aux1[!duplicated(aux1$id_veiculo),]
# Contabiliza ID's de veículos de 2017 - Contabiliza quantos veiculos por acidentes
aux1 <- table(aux1$id)
aux1 <- as.data.frame(aux1)
# Monta dataframe para 2017: Encontra Media e Mediana de veiculos envolvidos por acidentes
aux1 <- data.frame(Ano = 2017,
"N.Acidentes" = length(levels(factor(dados2017$id))),
"N.Veiculos" = length(levels(factor(dados2017$id_veiculo))),
Media = mean(aux1$Freq),
Mediana=median(aux1$Freq),
"1º Quartil" = quantile(aux1$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux1$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux1$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux1$Freq,na.rm = T))
# Pegando so o identificador de acidente, e o de veiculo e deixando só os veiculos não repetidos para 2018
aux2 <- data.frame(id = dados2018$id,id_veiculo = dados2018$id_veiculo)
aux2 <- aux2[!duplicated(aux2$id_veiculo),]
# Contabiliza ID's de veículos de 2018 - Contabiliza quantos veiculos por acidentes
aux2 <- table(aux2$id)
aux2 <- as.data.frame(aux2)
# Monta dataframe para 2018
aux2 <- data.frame(Ano = 2018,
"N.Acidentes" = length(levels(factor(dados2018$id))),
"N.Veiculos" = length(levels(factor(dados2018$id_veiculo))),
Media = mean(aux2$Freq),
Mediana=median(aux2$Freq),
"1º Quartil" = quantile(aux2$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux2$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux2$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux2$Freq,na.rm = T))
# Adiciona para o dataframe
aux1 <- rbind(aux1,aux2)
# Pegando so o identificador de acidente, e o de veiculo e deixando só os veiculos não repetidos para 2019
aux2 <- data.frame(id = dados2019$id,id_veiculo = dados2019$id_veiculo)
aux2 <- aux2[!duplicated(aux2$id_veiculo),]
# Contabiliza ID's de veículos de 2019 - Contabiliza quantos veiculos por acidentes
aux2 <- table(aux2$id)
aux2 <- as.data.frame(aux2)
# Monta dataframe para 2018
aux2 <- data.frame(Ano = 2019,
"N.Acidentes" = length(levels(factor(dados2019$id))),
"N.Veiculos" = length(levels(factor(dados2019$id_veiculo))),
Media = mean(aux2$Freq),
Mediana=median(aux2$Freq),
"1º Quartil" = quantile(aux2$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux2$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux2$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux2$Freq,na.rm = T))
# Adiciona para o data frame
aux1 <- rbind(aux1,aux2)
# Contem dados sobre numero de veiculos envolvidos em acidentes
colnames(aux1) <- c("Ano","Acidentes","Veiculos","Media","Mediana","1º_Quartil","3º_Quartil","99º_Percentil","Desvio_Padrao")
DT::datatable(aux1,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))Aqui, resumimos brevemente o numero de pessoas envolvidas em acidentes e algumas métricas estatísticas de interesse de pessoas por acidentes.
# Contabiliza ID's de acidentes de 2017 - Contabiliza quantas pessoas por acidentes
aux1 <- table(dados2017$id)
aux1 <- as.data.frame(aux1)
# Monta dataframe para 2017: Encontra Media e Mediana de pessoas envolvidas por acidentes
aux1 <- data.frame(Ano = 2017,
"N.Acidentes" = length(levels(factor(dados2017$id))),
"N.Pessoas" = length(levels(factor(dados2017$pesid))),
Media = mean(aux1$Freq),
Mediana=median(aux1$Freq),
"1º Quartil" = quantile(aux1$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux1$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux1$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux1$Freq,na.rm = T))
# Contabiliza ID's de acidentes de 2018
aux2 <- table(dados2018$id)
aux2 <- as.data.frame(aux2)
# Monta dataframe para 2018
aux2 <- data.frame(Ano = 2018,
"N.Acidentes" = length(levels(factor(dados2018$id))),
"N.Pessoas" = length(levels(factor(dados2018$pesid))),
Media = mean(aux2$Freq),
Mediana=median(aux2$Freq),
"1º Quartil" = quantile(aux2$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux2$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux2$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux2$Freq,na.rm = T))
# Adiciona para o dataframe
aux1 <- rbind(aux1,aux2)
# Contabiliza ID's de acidentes de 2019
aux2 <- table(dados2019$id)
aux2 <- as.data.frame(aux2)
# Monta dataframe para 2019
aux2 <- aux2 <- data.frame(Ano = 2019,
"N.Acidentes" = length(levels(factor(dados2019$id))),
"N.Pessoas" = length(levels(factor(dados2019$pesid))),
Media = mean(aux2$Freq),
Mediana=median(aux2$Freq),
"1º Quartil" = quantile(aux2$Freq, probs = c(0.25),names = FALSE),
"3º Quartil" = quantile(aux2$Freq, probs = c(0.75),names = FALSE),
"99º Percentil" = quantile(aux2$Freq, probs = c(0.99),names = FALSE),
"Desvio Padrao" = sd(aux2$Freq,na.rm = T))
# Adiciona para o data frame
aux1 <- rbind(aux1,aux2)
# Contem dados sobre numero de pessoas acidentadas
colnames(aux1) <- c("Ano",
"Acidentes",
"Pessoas",
"Media",
"Mediana",
"1º_Quartil",
"3º_Quartil",
"99º_Percentil",
"Desvio_Padrao")
DT::datatable(aux1,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))O atributo “estado_fisico” contém o estado físico da pessoa após o acidente. A baixo, foram plotados gráficos que demonstram como os valores do estados físicos das vítimas alteraram com o passar dos anos. Analisando estes, a primeira observação que podemos fazer é que há existência significante de valores ausentes. A segunda observação, é que no geral os casos seguem uma ordem de quantidade (decrescente): “Ileso”, “Lesões Leves”, “Lesões Graves”, “Não Informado” e “Óbito”. A terceira e última observação é sobre o comportamento dos valores com o passar dos anos. Podemos perceber que a quantidade de casos com pessoas ilesas só diminuiu com o passar dos anos. Enquanto isso, a quantidade dos outros estados físicos se manteve com o passar dos anos. O gráfico de proporções pode ser analisado, e é perceptível que a proporção de acidentes com pessoas mais gravemente feridas cresceu, enquanto a quantidade com ilesos diminuiu.
Conseguimos encontrar a duas alternativas a partir destas observações. A primeira, e mais interessante, é que com o passar dos anos, a gravidade dos acidentes estão aumentando, mesmo que a quantidade de acidentes está em declínio. Isto teoricamente não deveria acontecer já que nos novos modelos de veículos contém mais e mais recurso de segurança, mas na prática, a falta de fiscalização, sinalização e manutenção das rodovias poderia causar este aumento de gravidade. Pode ser que medidas tenham sido tomadas para diminuir acidentes no geral, mas essas medidas só funcionaram para acidentes de baixa gravidade. A segunda alternativa é que, como foi dito anteriormente, algo sobre a política da Polícia Rodoviária Federal sobre quais acidentes registrar possa ter mudado. Não conseguimos, sem mais informações, elaborar outra motivação clara para explicar este comportamento.
Para a aplicação de regras de associação enxergamos apenas uma manipulação que podemos fazer sobre este atributo, que é substituir os valores ausentes pelo valor “Não Informado” já que ele será importante para nossas análises de regras de associação. Talvez seria interessante remover registros de um mesmo veículo no mesmo acidente que registrassem estado físico menos graves do que os demais caso nenhuma regra fosse encontrada sem esta remoção, mas por enquanto achamos desnecessário.
# Funcao utilizado para sobreescrever valores de estado fisico NA com Nao Informado
preparaEstadoFisico <- function(dados){
levels(dados$estado_fisico) <- c(levels(dados$estado_fisico), "Não Informado")
dados$estado_fisico[which(is.na(dados$estado_fisico))] <- "Não Informado"
dados$estado_fisico <- droplevels(dados$estado_fisico)
return(dados)
}
dados2017 <- preparaEstadoFisico(dados2017)
dados2018 <- preparaEstadoFisico(dados2018)
dados2019 <- preparaEstadoFisico(dados2019)# Contabiliza os estado fisicos
aux1 <- as.data.frame(table(dados2017$estado_fisico,useNA = "ifany"),stringsAsFactors = FALSE)
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux1) <- c("Estado_Fisico","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux1$Estado_Fisico[is.na(aux1$Estado_Fisico)] <- "Não Informado"
aux1$Estado_Fisico <- as.factor(aux1$Estado_Fisico)
aux1$Estado_Fisico <- factor(aux1$Estado_Fisico,c("Não Informado","Ileso","Lesões Leves","Lesões Graves","Óbito"))
## Grafico de Frequencia de estado fisicos por ano
p1 <- ggplot(aux1, aes(x = Estado_Fisico, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Estado_Fisico)) +
ggtitle("a) Estado físico dos acidentados (2017)") +
xlab("Estado físico") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza os estado fisicos
aux2 <- as.data.frame(table(dados2018$estado_fisico,useNA = "ifany"),stringsAsFactors = FALSE)
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux2) <- c("Estado_Fisico","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux2$Estado_Fisico[is.na(aux2$Estado_Fisico)] <- "Não Informado"
aux2$Estado_Fisico <- as.factor(aux2$Estado_Fisico)
aux2$Estado_Fisico <- factor(aux2$Estado_Fisico,c("Não Informado","Ileso","Lesões Leves","Lesões Graves","Óbito"))
## Grafico de Frequencia de estado fisicos por ano
p1 <- ggplot(aux2, aes(x = Estado_Fisico, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Estado_Fisico)) +
ggtitle("b) Estado físico dos acidentados (2018)") +
xlab("Estado físico") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza os estado fisicos
aux3 <- as.data.frame(table(dados2019$estado_fisico,useNA = "ifany"),stringsAsFactors = FALSE)
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux3) <- c("Estado_Fisico","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux3$Estado_Fisico[is.na(aux3$Estado_Fisico)] <- "Não Informado"
aux3$Estado_Fisico <- as.factor(aux3$Estado_Fisico)
aux3$Estado_Fisico <- factor(aux3$Estado_Fisico,c("Não Informado","Ileso","Lesões Leves","Lesões Graves","Óbito"))
## Grafico de Frequencia de estado fisicos por ano
p1 <- ggplot(aux3, aes(x = Estado_Fisico, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Estado_Fisico)) +
ggtitle("c) Estado físico dos acidentados (2019)") +
xlab("Estado Físico") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando uma coluna de ano para os dataframes usados para os graficos
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Construindo um dataframe que contem os valores durante todos os anos
aux <- rbind(aux1,aux2,aux3)
aux$Estado_Fisico <- with(aux, reorder(Estado_Fisico, Quantidade, median))
## Grafico de Frequencia de estado fisicos por ano com todos anos
p1 <- ggplot(aux, aes(fill=Estado_Fisico, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Estado físico dos acidentados (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Estado Físico", labels = c("Não_Informado",
"Ileso",
"Lesões Leves",
"Lesões Leves",
"Óbito")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)## Grafico de Frequencia de estado fisicos por ano com todos anos
p1 <- ggplot(aux, aes(fill=Estado_Fisico, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Estado físico dos acidentados (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Estado Físico", labels = c("Não_Informado",
"Ileso",
"Lesões Leves",
"Lesões Leves",
"Óbito")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)A seguir analisamos o atributo “classificacao_acidente”. A classificação de um acidente é definida pelo estado físico mais grave das pessoas envolvidas no acidente. Acidentes sem vítimas são os que os estados físicos dos envolvidos são todos ilesos; Acidentes com vítimas feridas são acidentes que envolveram pessoas levemente ou gravemente feridas; e acidentes com vítimas fatais são acidentes que envolveram pessoas com que foram a óbito.
Abaixo plotamos dois grupos de gráficos. O primeiro, por pessoa, contabiliza a classificação das pessoas envolvidas nos acidentes. O segundo, por acidente, contabiliza a classificação de cada acidente registrado. Comparando as proporções entre estes dois, nota-se que a proporção de acidentes com mortes ou feridos é menor para a classificação de acidente. Isto mostra que geralmente, apesar de o acidente ser classificado com uma gravidade, nem todos envolvidos são feridos de forma tão grave.
Analisando os casos por pessoa, com o passar dos anos, a quantidade de pessoas em acidentes com classificação sem vítimas foi a que mais caiu. A quantidade pessoas em acidentes com vítimas feridas também caiu em 2018, mas aumentou novamente em 2019. Já a pessoas em acidentes com vítimas fatais caiu, mas muito pouco, e depois aumentou, também bem pouco. As proporções de sem vítimas caíram bastante com o passar dos anos, a de com vítimas feridas cresceu, e com vítimas fatais se manteve relativamente estável, aumentando em uma pequena quantidade.
# Contabiliza as classificacoes
aux1 <- as.data.frame(table(dados2017$classificacao_acidente,useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux1) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux1$Classificacao_Acidente <- factor(aux1$Classificacao_Acidente,c("Sem Vítimas",
"Com Vítimas Feridas",
"Com Vítimas Fatais"))
## Grafico de Frequencia de classificacao de acidentes por ano
p1 <- ggplot(aux1, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("a) Classificação dos acidentes (2017)") +
xlab("Classificação") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza as classificacoes
aux2 <- as.data.frame(table(dados2018$classificacao_acidente,useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux2) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux2$Classificacao_Acidente <- factor(aux2$Classificacao_Acidente,c("Sem Vítimas",
"Com Vítimas Feridas",
"Com Vítimas Fatais"))
## Grafico de Frequencia de classificacao de acidentes por ano
p1 <- ggplot(aux2, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("b) Classificação dos acidentes (2018)") +
xlab("Classificação") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza as classificacoes
aux3 <- as.data.frame(table(dados2019$classificacao_acidente,useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux3) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux3$Classificacao_Acidente <- factor(aux3$Classificacao_Acidente,c("Sem Vítimas",
"Com Vítimas Feridas",
"Com Vítimas Fatais"))
## Grafico de Frequencia de classificacao de acidentes por ano
p1 <- ggplot(aux3, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("c) Classificação dos acidentes (2019)") +
xlab("Classificação") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando uma coluna de ano para os dataframes usados para os graficos
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Construindo um dataframe que contem os valores durante todos os anos
aux <- rbind(aux1,aux2,aux3)
aux$Classificacao_Acidente <- with(aux, reorder(Classificacao_Acidente, Quantidade, median))
## Grafico de Frequencia de classificacao de acidentes por ano com todos anos
p1 <- ggplot(aux, aes(fill=Classificacao_Acidente, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Classificação dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Classificação", labels = c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)## Grafico de Frequencia de classificacao de acidentes por ano com todos anos
p1 <- ggplot(aux, aes(fill=Classificacao_Acidente, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Classificação dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Classificação", labels = c("Sem Vítimas",
"Com Vítimas Feridas",
"Com Vítimas Fatais")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Agora analisando os casos por acidentes, as mudanças são bem parecidas, porém desta vez os impactos são maiores. Isto é bem mais perceptível analisando as proporções, em que os casos de acidentes sem vítimas caem de 34,2% para 17,3%. Os números de acidentes com vítimas feridas ganharam quase essa diferença toda, e os casos com vítimas fatais se relativamente estável, com um pequeno crescimento.
# Contabiliza as classificacoes contabilizando o ID uma unica vez
aux1 <- as.data.frame(table(dados2017$classificacao_acidente[!duplicated(dados2017$id)],useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux1) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux1$Classificacao_Acidente <- factor(aux1$Classificacao_Acidente,c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais"))
## Grafico de Frequencia de acidentes por ano
p1 <- ggplot(aux1, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("a) Classificação dos acidentes (2017)") +
xlab("Classificação") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza as classificacoes contabilizando o ID uma unica vez
aux2 <- as.data.frame(table(dados2018$classificacao_acidente[!duplicated(dados2018$id)],useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux2) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux2$Classificacao_Acidente <- factor(aux2$Classificacao_Acidente,c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais"))
## Grafico de Frequencia de acidentes por ano
p1 <- ggplot(aux2, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("b) Classificação dos acidentes (2018)") +
xlab("Classificação") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza as classificacoes contabilizando o ID uma unica vez
aux3 <- as.data.frame(table(dados2019$classificacao_acidente[!duplicated(dados2019$id)],useNA = "ifany"))
# Sobreescreve nome das colunas - funcao table() gera outro nome
colnames(aux3) <- c("Classificacao_Acidente","Quantidade")
# Transforma a coluna com os nomes em factor para criar plot
aux3$Classificacao_Acidente <- factor(aux3$Classificacao_Acidente,c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais"))
## Grafico de Frequencia de acidentes por ano
p1 <- ggplot(aux3, aes(x = Classificacao_Acidente, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Classificacao_Acidente)) +
ggtitle("c) Classificação dos acidentes (2019)") +
xlab("Classificação") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando uma coluna de ano para os dataframes usados para os graficos
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Construindo um dataframe que contem os valores durante todos os anos
aux <- rbind(aux1,aux2,aux3)
aux$Classificacao_Acidente <- with(aux, reorder(Classificacao_Acidente, Quantidade, median))
## Grafico de Frequencia de classificacao de acidentes por ano com todos anos
p1 <- ggplot(aux, aes(fill=Classificacao_Acidente, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Classificação dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Classificação", labels = c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)## Grafico de Frequencia de classificacao de acidentes por ano com todos anos
p1 <- ggplot(aux, aes(fill=Classificacao_Acidente, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Classificação dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Classificação", labels = c("Sem Vítimas","Com Vítimas Feridas","Com Vítimas Fatais")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Nesta seção analisaremos os atributos do dataset que contém informações geográfica sobre o acontecimento dos acidentes. Aqui realizamos o estudo breve de sete atributos: “uf”; “municipio”; “latitude”; “longitude”; “br”, “km” e “sentido_via”.
Os atributos “latitude” e “longitude” contêm valores numéricos que correspondem a latitude e longitude que o acidente ocorreu. Um problema com este atributo é que ele tem que ser convertido para numérico. Para isso, tivemos que substituir o separador decimal, já que ele não era compatível com o do R. Utilizamos os atributos de coordenadas para gerar um mapa de calor e também plotamos os pontos de todos acidentes, com um breve resumo sobre cada acidente. Referente aos dados de 2017, observamos uma pequena quantidade de coordenadas que estão fora do território nacional, ou com um offset, não trataremos estes casos. Para os outros anos, as coordenadas parecem estar todas certas. Não discutiremos o que se pode concluir dos gráficos agora, mas no final da análise, podemos utilizar eles para confirmar certas regras.
Devido a quantidade de dados presente na nossa base de dados, o gráfico gerado fica computacionalmente pesado e por isso não incluímos eles no relatório final. Percebemos isto apenas após gerar os gráficos. Para elaborar este tipo de gráfico, tivemos uma dificuldade considerável para encontrar material, por isso, achamos importante documentar os resultados. Além de ser possível gerar esses gráficos no seu próprio computador utilizando o documento disponibilizado no Github (o código está nesta seção, apenas não executamos ele), geramos vídeos para demonstrar o mapa gerado para aqueles que não consigam utilizar o documento. Também anexamos um link para baixar cada versão do mapa em formato “.html”, que pode ser aberto em qualquer navegador.
Achamos válido comentar que comparado aos outros anos, este é o único que apresenta uma espécie de ruído nas coordenadas. Para baixar este mapa clique aqui, o arquivo possuí 33.7MB.
library(leaflet)
library(leaflet.extras)
library(dplyr)
# Remove acidentes com veiculos NA - Estava atrapalhando a plotagem
dados2017 <- dados2017[!is.na(dados2017$id_veiculo),]
# Pega registros por acidentes
aux1 <- as.data.frame(dados2017$id[!duplicated(dados2017$id)])
# Processamento dos atributos latitude e longitude para plotagem
aux1$Latitude <- dados2017$latitude[!duplicated(dados2017$id)]
aux1$Longitude <- dados2017$longitude[!duplicated(dados2017$id)]
aux1$Latitude <- as.character(aux1$Latitude)
aux1$Latitude <- gsub(",", ".", aux1$Latitude);
aux1$Latitude <- as.numeric(aux1$Latitude)
aux1$Longitude <- as.character(aux1$Longitude)
aux1$Longitude <- gsub(",", ".", aux1$Longitude);
aux1$Longitude <- as.numeric(aux1$Longitude)
# Obtendo Classificacao dos acidentes
aux1$classificacao_acidente <- dados2017$classificacao_acidente[!duplicated(dados2017$id)]
# Obtendo numero de pessoas e numero de veiculos por acidentes
aux1$nPessoas <- as.data.frame(table(dados2017$id))$Freq
aux1$nVeiculos <- as.data.frame(table(dados2017$id[!duplicated(dados2017$id_veiculo)]))$Freq
# Obtendo numero de cada tipo de estado fisico por acidente
temp <- as.data.frame(table(dados2017$estado_fisico,dados2017$id))
aux1$nIleso <- temp[temp$Var1 == "Ileso",]$Freq
aux1$nFLeve <- temp[temp$Var1 == "Lesões Leves",]$Freq
aux1$nFGrave <- temp[temp$Var1 == "Lesões Graves",]$Freq
aux1$nObito <- temp[temp$Var1 == "Óbito",]$Freq
# Renomeando colunas
colnames(aux1) <- c("ID","Latitude","Longitude","classificacao_acidente","n_Pessoas","n_Veiculos","n_Ileso","n_FLeve","n_FGrave","n_Obito")
# Cor dos marcadores
getColor <- function(aux1) {
sapply(aux1$classificacao_acidente, function(classificacao_acidente) {
if(classificacao_acidente == "Sem Vítimas" ) {
"green"
} else if(classificacao_acidente == "Com Vítimas Feridas") {
"orange"
} else {
"red"
} })
}
# Plotando com leaflet
p1 <- leaflet() %>%
addTiles() %>%
fitBounds(-73.9872354804, -33.7683777809, -34.7299934555, 5.24448639569) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addHeatmap(lng = aux1$Longitude, lat = aux1$Latitude,radius = 6,group = "Mapa de calor") %>%
addAwesomeMarkers(data = aux1,
popup = paste0("<br><strong>Identificador: </strong> ",aux1$ID,
"<br><strong>Classificação: </strong> ",aux1$classificacao_acidente,
"<br><strong>Veículos: </strong> ",aux1$n_Veiculos,
"<br><strong>Acidentados: </strong> ",aux1$n_Pessoas,
"<br><strong>Ilesos: </strong> ", aux1$n_Ileso,
"<br><strong>Feridos Leves: </strong> ",aux1$n_FLeve,
"<br><strong>Feridos Graves: </strong> ",aux1$n_FGrave,
"<br><strong>Óbitos: </strong> ", aux1$n_Obito),
lng = ~Longitude,
lat = ~Latitude,
group = "Marcadores",
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = T),
icon = awesomeIcons(library = 'ion',
icon = 'ion-android-car',
iconColor = 'black',
markerColor = getColor(aux1))
) %>%
addResetMapButton() %>%
addLayersControl(
overlayGroups = c("Mapa de calor", "Marcadores"),
options = layersControlOptions(collapsed = FALSE)
)
p1Para baixar este mapa clique aqui, o arquivo possuí 26.4MB.
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Remove acidentes com veiculos NA - Estava atrapalhando a plotagem
dados2018 <- dados2018[!is.na(dados2018$id_veiculo),]
# Pega registros por acidentes
aux1 <- as.data.frame(dados2018$id[!duplicated(dados2018$id)])
# Processamento dos atributos latitude e longitude para plotagem
aux1$Latitude <- dados2018$latitude[!duplicated(dados2018$id)]
aux1$Longitude <- dados2018$longitude[!duplicated(dados2018$id)]
aux1$Latitude <- as.character(aux1$Latitude)
aux1$Latitude <- gsub(",", ".", aux1$Latitude);
aux1$Latitude <- as.numeric(aux1$Latitude)
aux1$Longitude <- as.character(aux1$Longitude)
aux1$Longitude <- gsub(",", ".", aux1$Longitude);
aux1$Longitude <- as.numeric(aux1$Longitude)
# Obtendo Classificacao dos acidentes
aux1$classificacao_acidente <- dados2018$classificacao_acidente[!duplicated(dados2018$id)]
# Obtendo numero de pessoas e numero de veiculos por acidentes
aux1$nPessoas <- as.data.frame(table(dados2018$id))$Freq
aux1$nVeiculos <- as.data.frame(table(dados2018$id[!duplicated(dados2018$id_veiculo)]))$Freq
# Obtendo numero de cada tipo de estado fisico por acidente
temp <- as.data.frame(table(dados2018$estado_fisico,dados2018$id))
aux1$nIleso <- temp[temp$Var1 == "Ileso",]$Freq
aux1$nFLeve <- temp[temp$Var1 == "Lesões Leves",]$Freq
aux1$nFGrave <- temp[temp$Var1 == "Lesões Graves",]$Freq
aux1$nObito <- temp[temp$Var1 == "Óbito",]$Freq
# Renomeando colunas
colnames(aux1) <- c("ID","Latitude","Longitude","classificacao_acidente","n_Pessoas","n_Veiculos","n_Ileso","n_FLeve","n_FGrave","n_Obito")
# Cor dos marcadores
getColor <- function(aux1) {
sapply(aux1$classificacao_acidente, function(classificacao_acidente) {
if(classificacao_acidente == "Sem Vítimas" ) {
"green"
} else if(classificacao_acidente == "Com Vítimas Feridas") {
"orange"
} else {
"red"
} })
}
# Plotando com leaflet
p2 <- leaflet() %>%
addTiles() %>%
fitBounds(-73.9872354804, -33.7683777809, -34.7299934555, 5.24448639569) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addHeatmap(lng = aux1$Longitude, lat = aux1$Latitude,radius = 6,group = "Mapa de calor") %>%
addAwesomeMarkers(data = aux1,
popup = paste0("<br><strong>Identificador:</strong> ",aux1$ID,
"<br><strong>Classificação:</strong> ",aux1$classificacao_acidente,
"<br><strong>Veículos:</strong> ",aux1$n_Veiculos,
"<br><strong>Acidentados:</strong> ",aux1$n_Pessoas,
"<br><strong>Ilesos:</strong> ", aux1$n_Ileso,
"<br><strong>Feridos Leves:</strong> ",aux1$n_FLeve,
"<br><strong>Feridos Graves:</strong> ",aux1$n_FGrave,
"<br><strong>Óbitos:</strong> ", aux1$n_Obito),
lng = ~Longitude,
lat = ~Latitude,
group = "Marcadores",
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = T),
icon = awesomeIcons(library = 'ion',
icon = 'ion-android-car',
iconColor = 'black',
markerColor = getColor(aux1))
) %>%
addResetMapButton() %>%
addLayersControl(
overlayGroups = c("Mapa de calor", "Marcadores"),
options = layersControlOptions(collapsed = FALSE)
)
p2Para baixar este mapa clique aqui, o arquivo possuí 25.9MB.
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Remove acidentes com veiculos NA - Estava atrapalhando a plotagem
dados2019 <- dados2019[!is.na(dados2019$id_veiculo),]
# Pega registros por acidentes
aux1 <- as.data.frame(dados2019$id[!duplicated(dados2019$id)])
# Processamento dos atributos latitude e longitude para plotagem
aux1$Latitude <- dados2019$latitude[!duplicated(dados2019$id)]
aux1$Longitude <- dados2019$longitude[!duplicated(dados2019$id)]
aux1$Latitude <- as.character(aux1$Latitude)
aux1$Latitude <- gsub(",", ".", aux1$Latitude);
aux1$Latitude <- as.numeric(aux1$Latitude)
aux1$Longitude <- as.character(aux1$Longitude)
aux1$Longitude <- gsub(",", ".", aux1$Longitude);
aux1$Longitude <- as.numeric(aux1$Longitude)
# Obtendo Classificacao dos acidentes
aux1$classificacao_acidente <- dados2019$classificacao_acidente[!duplicated(dados2019$id)]
# Obtendo numero de pessoas e numero de veiculos por acidentes
aux1$nPessoas <- as.data.frame(table(dados2019$id))$Freq
aux1$nVeiculos <- as.data.frame(table(dados2019$id[!duplicated(dados2019$id_veiculo)]))$Freq
# Obtendo numero de cada tipo de estado fisico por acidente
temp <- as.data.frame(table(dados2019$estado_fisico,dados2019$id))
aux1$nIleso <- temp[temp$Var1 == "Ileso",]$Freq
aux1$nFLeve <- temp[temp$Var1 == "Lesões Leves",]$Freq
aux1$nFGrave <- temp[temp$Var1 == "Lesões Graves",]$Freq
aux1$nObito <- temp[temp$Var1 == "Óbito",]$Freq
# Renomeando colunas
colnames(aux1) <- c("ID","Latitude","Longitude","classificacao_acidente","n_Pessoas","n_Veiculos","n_Ileso","n_FLeve","n_FGrave","n_Obito")
# Cor dos marcadores
getColor <- function(aux1) {
sapply(aux1$classificacao_acidente, function(classificacao_acidente) {
if(classificacao_acidente == "Sem Vítimas" ) {
"green"
} else if(classificacao_acidente == "Com Vítimas Feridas") {
"orange"
} else {
"red"
} })
}
# Plotando com leaflet
p3 <- leaflet() %>%
addTiles() %>%
fitBounds(-73.9872354804, -33.7683777809, -34.7299934555, 5.24448639569) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addHeatmap(lng = aux1$Longitude, lat = aux1$Latitude,radius = 6,group = "Mapa de calor") %>%
addAwesomeMarkers(data = aux1,
popup = paste0("<br><strong>Identificador:</strong> ",aux1$ID,
"<br><strong>Classificação:</strong> ",aux1$classificacao_acidente,
"<br><strong>Veículos:</strong> ",aux1$n_Veiculos,
"<br><strong>Acidentados:</strong> ",aux1$n_Pessoas,
"<br><strong>Ilesos:</strong> ", aux1$n_Ileso,
"<br><strong>Feridos Leves:</strong> ",aux1$n_FLeve,
"<br><strong>Feridos Graves:</strong> ",aux1$n_FGrave,
"<br><strong>Óbitos:</strong> ", aux1$n_Obito),
lng = ~Longitude,
lat = ~Latitude,
group = "Marcadores",
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = T),
icon = awesomeIcons(library = 'ion',
icon = 'ion-android-car',
iconColor = 'black',
markerColor = getColor(aux1))
) %>%
addResetMapButton() %>%
addLayersControl(
overlayGroups = c("Mapa de calor", "Marcadores"),
options = layersControlOptions(collapsed = FALSE)
)
p3O atributo “uf” diz em qual unidade federativa (estado) o acidente ocorreu. Devido a alta quantidade de valores distintos, e a grande variação de número de acidentes, ao invés de plotar um data frame ou um gráfico de barra, optamos por plotar um mapa coroplético interativo.
Os dados dos limites interestaduais utilizados nesta seção foram encontrados no site do IBGE (Instituto Brasileiro de Geografia e Estatística 2020), na seção de downloads de geociências. Para o mapa de estado acessamos o diretório: “/organizacao_do_territorio/malhas_territoriais/malhas_municipais/municipio_2018/Brasil/BR/br_unidades_da_federacao”. Em seguida contabilizamos a quantidade de acidentes por estado e acrescentamos o código de cada estado. Então, foi possível unir os dados do mapa e as informações contabilizadas, e o gráfico foi plotado.
Devido ao tamanho devido a quantidade de dados presente nos gráficos, optamos por repetir a análise na forma que fizemos com as coordenadas. Além de disponibilizar este arquivo com todos os arquivos necessários para executar este projeto (logo você pode executar este trecho de código e gerar os gráficos), anexamos vídeos que demonstram o gráfico para cada ano e também disponibilizamos os links de download para cada gráfico.
Para baixar este mapa clique aqui, o arquivo possuí 24.4MB.
# Importando o shape do mapa
shp <- rgdal::readOGR(dsn = ".",
layer = "BRUFE250GC_SIR",
stringsAsFactors=FALSE,
encoding="UTF-8")
# Criando o resumo de acidentes por estado
aux1 <- as.data.frame(table(dados2017$uf[!duplicated(dados2017$id)],useNA = "ifany"))
colnames(aux1) <- c("Estado","Quantidade")
aux1$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
# Uniao dos dados
mapa2017 <- merge(shp,aux1, by.x = "CD_GEOCUF", by.y = "Codigo.UF")
# Tratamento do dataframe espacial
proj4string(mapa2017) <- CRS("+proj=longlat +datum=WGS84 +no_defs")
Encoding(mapa2017$NM_ESTADO) <- "UTF-8"
mapa2017$Quantidade[is.na(mapa2017$Quantidade)] <- 0
# Plotagem
pal <- colorBin("YlOrBr",domain = mapa2017@data$Quantidade,n=10)
state_popup <- paste0("<strong>Estado: </strong>", mapa2017$NM_ESTADO, "<br><strong>Acidentes: </strong>", mapa2017$Quantidade)
p1 <- leaflet(data = mapa2017) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(fillColor = ~pal(mapa2017$Quantidade),
fillOpacity = 0.8,
color = "#BDBDC3",
weight = 1,
popup = state_popup) %>%
addLegend("bottomright", pal = pal, values = ~mapa2017$Quantidade,title = "Numero de acidentes por UF", opacity = 1) %>%
addResetMapButton()
p1Para baixar este mapa clique aqui, o arquivo possuí 24.4MB.
# Criando o resumo de acidentes por estado
aux2 <- as.data.frame(table(dados2018$uf[!duplicated(dados2018$id)],useNA = "ifany"))
colnames(aux2) <- c("Estado","Quantidade")
aux2$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
# Uniao dos dados
mapa2018 <- merge(shp,aux2, by.x = "CD_GEOCUF", by.y = "Codigo.UF")
# Tratamento do dataframe espacial
proj4string(mapa2018) <- sp::CRS("+proj=longlat +datum=WGS84 +no_defs")
Encoding(mapa2018$NM_ESTADO) <- "UTF-8"
mapa2018$Quantidade[is.na(mapa2018$Quantidade)] <- 0
# Plotagem
pal <- colorBin("YlOrBr",domain = mapa2018@data$Quantidade,n=10)
state_popup <- paste0("<strong>Estado: </strong>", mapa2018$NM_ESTADO, "<br><strong>Acidentes: </strong>", mapa2018$Quantidade)
p2 <- leaflet(data = mapa2018) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(fillColor = ~pal(mapa2018$Quantidade),
fillOpacity = 0.8,
color = "#BDBDC3",
weight = 1,
popup = state_popup) %>%
addLegend("bottomright", pal = pal, values = ~mapa2018$Quantidade,title = "Numero de acidentes por UF", opacity = 1) %>%
addResetMapButton()
p2Para baixar este mapa clique aqui, o arquivo possuí 24.4MB.
# Criando o resumo de acidentes por estado
aux3 <- as.data.frame(table(dados2019$uf[!duplicated(dados2019$id)],useNA = "ifany"))
colnames(aux3) <- c("Estado","Quantidade")
aux3$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
# Uniao dos dados
mapa2019 <- merge(shp,aux3, by.x = "CD_GEOCUF", by.y = "Codigo.UF")
# Tratamento do dataframe espacial
proj4string(mapa2019) <- sp::CRS("+proj=longlat +datum=WGS84 +no_defs")
Encoding(mapa2019$NM_ESTADO) <- "UTF-8"
mapa2019$Quantidade[is.na(mapa2019$Quantidade)] <- 0
# Plotagem
pal <- colorBin("YlOrBr",domain = mapa2019@data$Quantidade,n=10)
state_popup <- paste0("<strong>Estado: </strong>", mapa2019$NM_ESTADO, "<br><strong>Acidentes: </strong>", mapa2019$Quantidade)
p3 <- leaflet(data = mapa2019) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(fillColor = ~pal(mapa2019$Quantidade),
fillOpacity = 0.8,
color = "#BDBDC3",
weight = 1,
popup = state_popup) %>%
addLegend("bottomright", pal = pal, values = ~mapa2019$Quantidade,title = "Numero de acidentes por UF", opacity = 1) %>%
addResetMapButton()
p3Para mostrar todos os anos, não tivemos outra alternativa a não ser criar um gráfico de barras.
# Criando o resumo de acidentes por estado
aux1 <- as.data.frame(table(dados2017$uf[!duplicated(dados2017$id)],useNA = "ifany"))
colnames(aux1) <- c("Estado","Quantidade")
aux1$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
aux2 <- as.data.frame(table(dados2018$uf[!duplicated(dados2018$id)],useNA = "ifany"))
colnames(aux2) <- c("Estado","Quantidade")
aux2$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
aux3 <- as.data.frame(table(dados2019$uf[!duplicated(dados2019$id)],useNA = "ifany"))
colnames(aux3) <- c("Estado","Quantidade")
aux3$Codigo.UF <- c(12,27,13,16,29,23,53,32,52,21,31,50,51,15,25,26,22,41,33,24,11,14,43,42,28,35,17)
# Adicionado um coluna com o ano ao qual o data frame se refere
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Realizando a uniao entre dataframes e reordenando eles por quantidade
aux <- rbind(aux1,aux2,aux3)
aux$Estado <- with(aux, reorder(Estado, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill = Estado, y = Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Estado dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico por proporcoes
p1 <- ggplot(aux, aes(fill=Estado, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Estado dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Este atributo pode ser utilizado para identificar o nome do município em que cada acidente ocorreu. Os gráficos de município não foram plotados já que não encontramos uma forma de anexar os dados obtidos para o mapa. Este atributo pode ser utilizado diretamente na formação de regras, e pode vir a destacar padrões diferentes para cada cidade. O atributo também permite selecionar certas cidades e filtrar os dados.
Aqui, montamos um data frame que contabiliza a quantidade de ocorrência de acidentes por município, e então mostramos apenas os 50 primeiros itens. Um padrão observável é que durante os três anos, os 4 primeiros itens não mudam, apenas trocam de posições. Caso o leitor queira explorar mais municípios, básica executar esta seção de código para gerar o data frame que contem a contabilização de acidentes para todos municípios. Ao invés de imprimir só os primeiros 50 valores, pode imprimir o data frame inteiro.
# Contabilizando identificadores distintos de acidentes por municipio
aux1 <- as.data.frame(table(dados2017$municipio[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() renomeia as colunas
colnames(aux1) <- c("BR","Quantidade")
# Ordenando os municipios por ordem descrecente de numero de acidentes
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando o data frame usando um data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10,scrollX=T))# Contabilizando identificadores distintos de acidentes por municipio
aux1 <- as.data.frame(table(dados2018$municipio[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() renomeia as colunas
colnames(aux1) <- c("BR","Quantidade")
# Ordenando os municipios por ordem descrecente de numero de acidentes
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando o data frame usando um data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))# Contabilizando identificadores distintos de acidentes por municipio
aux1 <- as.data.frame(table(dados2019$municipio[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() renomeia as colunas
colnames(aux1) <- c("BR","Quantidade")
# Ordenando os municipios por ordem descrecente de numero de acidentes
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando o data frame usando um data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10,scrollX=T))O atributo “br” é responsável por identificar em qual rodovia federal ocorreu o acidente. Novamente, temos um atributo com muitos valores distintos, o que torna ele difícil de analisar visualmente. Repetimos a mesma abordagem que fizemos com os municípios, ordenamos os valores por quantidade de acidentes, e então mostramos os 50 valores que mais se repetem. Este atributo também possui valores ausentes, então devemos substituir ele pelo valor “Não Informado”. Caso seja desejado inspecionar o número de acidentes para todas BRs, basta abrir o documento “.rmd” disponibilizado e executar o código desta seção. Ao invés de inspecionar os primeiros 50 valores, pode-se imprimir o data frame inteiro.
# ENTRADA: Recebe um unico parametro que e o dataframe contendo nossa base de dados
# SAIDA: Trasforma a coluna BR de valores numericos para fatores alem de lidar com valores ausentes
preparaBR <- function(dados){
# Transforma a coluna de BR em factor
dados$br <- as.factor(dados$br)
# Insere o level "Nao Informado" aos factors para poder incluir os valores NA
levels(dados$br) <- c(levels(dados$br), "Não Informado")
# Substitui valores NA por Nao Informado
dados$br[which(is.na(dados$br))] <- "Não Informado"
# Remove levels nao utilizado
dados$br <- droplevels(dados$br)
return(dados)
}
# Aplicando a funcao para os tres anos
dados2017 <- preparaBR(dados2017)
dados2018 <- preparaBR(dados2018)
dados2019 <- preparaBR(dados2019)# Contabilizado as quantidade de identificadores de acidentes nao repetidos por BR
aux1 <- as.data.frame(table(dados2017$br[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda o nome das colunas
colnames(aux1) <- c("Municipio","Quantidade")
# Reordenando o dataframe em ordem descrescente de quantidade de acidentes por BR
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando os primeiros 50 valores do dataframe utilizando data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))# Contabilizado as quantidade de identificadores de acidentes nao repetidos por BR
aux1 <- as.data.frame(table(dados2018$br[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda o nome das colunas
colnames(aux1) <- c("Municipio","Quantidade")
# Reordenando o dataframe em ordem descrescente de quantidade de acidentes por BR
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando os primeiros 50 valores do dataframe utilizando data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))# Contabilizado as quantidade de identificadores de acidentes nao repetidos por BR
aux1 <- as.data.frame(table(dados2019$br[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda o nome das colunas
colnames(aux1) <- c("Municipio","Quantidade")
# Reordenando o dataframe em ordem descrescente de quantidade de acidentes por BR
aux1 <- aux1[order(-aux1$Quantidade),]
# Mostrando os primeiros 50 valores do dataframe utilizando data table
DT::datatable(head(aux1, n = 50),
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))O atributo “km” é responsável por denotar em qual trecho da rodovia, no estado atual, o acidente ocorreu. Um acidente em uma mesma “br” pode ter o mesmo valor de “km” mas ser referente a dois pontos completamente diferente. O valor de “km” é zerado ao se cruzar as fronteiras entre estados. Primeiro temos que converter este atributo em valores numéricos. Para isto vamos usar a mesma técnica usada para as coordenadas. Também vamos dividir os valores em bins de 10 quilômetros. Utilizamos um gráfico de linhas para permitir a visualização dos dados referentes a “km”. Como o atributo possui valores ausentes, precisamos substituir estes valores por “Não Informado”. Deixamos para fazer isto após a plotagem dos gráficos para poder plotar o gráfico de dispersão, já que este não funciona com fatores.
# ENTRADA: Recebe como entrada a coluna de KM em valores numericos
# SAIDA: A coluna KM separada em categorias de 10 em 10 KM's com factors
converteKM <- function(km){
# Converte a coluna de KM em uma string
km <- as.character(km)
# Substitui o separador numerico pelo correto para transformar em numerico
km <- gsub(",",".",km)
# Converte os valores em tipo numerico
km <- as.numeric(km)
# Divide os valores de KM em grupos de 10 em 10 KMs
km <- cut(km,seq(0,1250,by=10))
return(km)
}
# Utilizando a funcao para atualizar os dados
dados2017$km <- converteKM(dados2017$km)
dados2018$km <- converteKM(dados2018$km)
dados2019$km <- converteKM(dados2019$km)# Contabilizando identificadores de acidente por trecho de KM
aux1 <- as.data.frame(table(dados2017$km[!duplicated(dados2017$id)]))
# Substituindo o nome das colunas ja que a funcao cria outros nomes
colnames(aux1) <- c("KM","Quantidade")
# Plotando o grafico de linhas
p1 <- aux1 %>%
ggplot(aes(x = KM, y = Quantidade, group=1)) +
geom_point(color = "#69b3a2") +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
ggtitle("a) Quantidade de acidentes por trecho de KM (2017)") +
xlab("Trecho de KM") +
ylab("Acidentes") +
theme(axis.text.x=element_blank())
ggplotly(p1) # Contabilizando identificadores de acidente por trecho de KM
aux2 <- as.data.frame(table(dados2018$km[!duplicated(dados2018$id)]))
# Substituindo o nome das colunas ja que a funcao cria outros nomes
colnames(aux2) <- c("KM","Quantidade")
# Plotando o grafico de linhas
p2 <- aux2 %>%
ggplot(aes(x = KM, y = Quantidade, group=1)) +
geom_point(color = "#69b3a2") +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
ggtitle("b) Quantidade de acidentes por trecho de KM (2018)") +
xlab("Trecho de KM") +
ylab("Acidentes") +
theme(axis.text.x=element_blank())
ggplotly(p2) # Contabilizando identificadores de acidente por trecho de KM
aux3 <- as.data.frame(table(dados2019$km[!duplicated(dados2019$id)]))
# Substituindo o nome das colunas ja que a funcao cria outros nomes
colnames(aux3) <- c("KM","Quantidade")
# Plotando o grafico de linhas
p3 <- aux3 %>%
ggplot(aes(x = KM, y = Quantidade, group=1)) +
geom_point(color = "#69b3a2") +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
ggtitle("c) Quantidade de acidentes por trecho de KM (2019)") +
xlab("Trecho de KM") +
ylab("Acidentes") +
theme(axis.text.x=element_blank())
ggplotly(p3) # Criando as colunas de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Combinando os dataframes
aux <- rbind(aux1,aux2,aux3)
aux$Ano <- as.factor(aux$Ano)
# Plotando o grafico de linhas
p1 <- aux %>%
ggplot(aes(x = KM, y = Quantidade, color = Ano, group = Ano)) +
geom_point() +
geom_line() +
ggtitle("d) Quantidade de acidentes por trecho de KM (2017 - 2019)") +
xlab("Trecho de KM") +
ylab("Acidentes") +
theme(axis.text.x=element_blank()) +
scale_color_viridis(discrete = TRUE)
ggplotly(p1)# Utilizado para adicionar os valores não informados - que nao fizemos antes se nao o grafico nao compila
preparaKM <- function(dados){
dados$km <- as.factor(dados$km)
levels(dados$km) <- c(levels(dados$km), "Não Informado")
dados$km[which(is.na(dados$km))] <- "Não Informado"
dados$km <- droplevels(dados$km)
return(dados)
}
dados2017 <- preparaKM(dados2017)
dados2018 <- preparaKM(dados2018)
dados2019 <- preparaKM(dados2019)Vale comentar a existência do atributo “sentido_via”. Ele é um atributo auxiliar ao quilômetro e diz que se o acidente ocorreu no sentido da via em que o quilômetro cresce ou decresce. Não enxergamos nenhuma aplicação pois a interpretação do que ele significa depende de muitos outros fatores. Abaixo mostramos um data frame que resume os seus valores durante os anos. Como este atributo possui valores ausentes, precisamos converter estes valores para “Não Informado”.
preparaSentido <- function(dados){
# Adicionando o level Nao Informado para o factor
levels(dados$sentido_via) <- c(levels(dados$sentido_via), "Não Informado")
# Encontrando os valores NA e substituindo por Nao Informado
dados$sentido_via[which(is.na(dados$sentido_via))] <- "Não Informado"
# Removendo niveis ausentes
dados$sentido_via <- droplevels(dados$sentido_via)
return(dados)
}
# Substituindo os valores NA por Nao Informado utilizando a funcao
dados2017 <- preparaSentido(dados2017)
dados2018 <- preparaSentido(dados2018)
dados2019 <- preparaSentido(dados2019)# Contabilizando quantidade de identificadores de acidente distintos por sentido
aux1 <- as.data.frame(table(dados2017$sentido_via[!duplicated(dados2017$id)],
useNA = "ifany"),
stringsAsFactors = FALSE)
# Renomeando as colunas ja que a funcao table() substitui os nomes
colnames(aux1) <- c("Sentido","Quantidade")
# Mostrando o dataframe usando datatable
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))# Contabilizando quantidade de identificadores de acidente distintos por sentido
aux1 <- as.data.frame(table(dados2018$sentido_via[!duplicated(dados2018$id)],useNA = "ifany"),stringsAsFactors = FALSE)
# Renomeando as colunas ja que a funcao table() substitui os nomes
colnames(aux1) <- c("Sentido","Quantidade")
aux1$Sentido[is.na(aux1$Sentido)] <- "Não Informado"
aux1$Sentido <- as.factor(aux1$Sentido)
# Mostrando o dataframe usando datatable
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))# Contabilizando quantidade de identificadores de acidente distintos por sentido
aux1 <- as.data.frame(table(dados2019$sentido_via[!duplicated(dados2019$id)],useNA = "ifany"),stringsAsFactors = FALSE)
# Renomeando as colunas ja que a funcao table() substitui os nomes
colnames(aux1) <- c("Sentido","Quantidade")
aux1$Sentido[is.na(aux1$Sentido)] <- "Não Informado"
aux1$Sentido <- as.factor(aux1$Sentido)
# Mostrando o dataframe usando datatable
DT::datatable(aux1, rownames = FALSE, filter="top", options = list(pageLength = 10, scrollX=T))O atributo “dia_semana” informa o dia da semana em que o acidente ocorreu. Criamos um grupo de gráficos que contabiliza o dia da semana de cada acidente. Com estes gráficos é possível analisar a distribuição de acidentes pela semana. Com o passar dos anos, há uma variação entre a quantidade de acidentes que ocorrem, mas mudanças nas proporções são praticamente imperceptíveis. É válido destacar que os finais de semana (sexta-feira, sábado e domingo) são acidentes que tem uma proporção maior de registro de acidentes.
# Contabilizando os identificadores unicos de acidentes por dia da semana
aux1 <- as.data.frame(table(dados2017$dia_semana[!duplicated(dados2017$id)],useNA = "ifany"))
# Substituindo o nome das colunas ja que a funcao table() altera os nomes
colnames(aux1) <- c("Dia_Semana","Quantidade")
#definindo os niveis para o dia da semana
aux1$Dia_Semana <- factor(aux1$Dia_Semana,c("segunda-feira",
"terça-feira",
"quarta-feira",
"quinta-feira",
"sexta-feira",
"sábado",
"domingo"))
# Plotando o grafico de barras
p1 <- ggplot(aux1, aes(x = Dia_Semana, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Dia_Semana)) +
ggtitle("a) Dia da semana dos acidentes (2017)") +
xlab("Dia da semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os identificadores unicos de acidentes por dia da semana
aux2 <- as.data.frame(table(dados2018$dia_semana[!duplicated(dados2018$id)],useNA = "ifany"))
# Substituindo o nome das colunas ja que a funcao table() altera os nomes
colnames(aux2) <- c("Dia_Semana","Quantidade")
#definindo os niveis para o dia da semana
aux2$Dia_Semana <- factor(aux2$Dia_Semana,c("segunda-feira",
"terça-feira",
"quarta-feira",
"quinta-feira",
"sexta-feira",
"sábado",
"domingo"))
# Plotando o grafico de barras
p1 <- ggplot(aux2, aes(x = Dia_Semana, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Dia_Semana)) +
ggtitle("b) Dia da semana dos acidentes (2018)") +
xlab("Dia da semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os identificadores unicos de acidentes por dia da semana
aux3 <- as.data.frame(table(dados2019$dia_semana[!duplicated(dados2019$id)],useNA = "ifany"))
# Substituindo o nome das colunas ja que a funcao table() altera os nomes
colnames(aux3) <- c("Dia_Semana","Quantidade")
#definindo os niveis para o dia da semana
aux3$Dia_Semana <- factor(aux3$Dia_Semana,c("segunda-feira",
"terça-feira",
"quarta-feira",
"quinta-feira",
"sexta-feira",
"sábado",
"domingo"))
# Plotando o grafico de barras
p1 <- ggplot(aux3, aes(x = Dia_Semana, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Dia_Semana)) +
ggtitle("c) Dia da semana dos acidentes (2019)") +
xlab("Dia da semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Criando a coluna de anos nos tres data frames
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Armazenando a uniao dos data frames para ter dados sobre todos os anos
aux <- rbind(aux1,aux2,aux3)
# Reoordenando o dia da semana por quantidade decrescente de acidentes
aux$Dia_Semana <- with(aux, reorder(Dia_Semana, Quantidade, median))
# Plotando o grafico de barras preenchido
p1 <- ggplot(aux, aes(fill=Dia_Semana, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Dia da semana dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Dia da semana",
labels = c("segunda-feira",
"terça-feira",
"quarta-feira",
"quinta-feira",
"sexta-feira",
"sábado",
"domingo")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico de barras preenchido
p1 <- ggplot(aux, aes(fill=Dia_Semana, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Dia da semana dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Dia da semana",
labels = c("segunda-feira",
"terça-feira",
"quarta-feira",
"quinta-feira",
"sexta-feira",
"sábado",
"domingo")) +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Nesta próxima etapa iremos analisar o atributo “data_inversa”. Este atributo contém a data do acidente do envolvido em formato “AAAA-MM-DD”. Inicialmente, o atributo é importado com factor, mas o R tem suporte para o tipo “Date”, então podemos converter esta coluna. Usaremos a biblioteca “lubridate” para realizar esta conversão já que ela possui várias funções prontas de manipulação de datas.
Também criaremos novos atributos chamados de “data_dia”,“data_mes”, “data_ano” e “data_semana” para separar as informações do atributo. O motivo de separar eles é já prevendo que eles podem (ou não) ser fatores importantes para indicar um número elevado de acidentes de certos perfis.
# ENTRADA: Dataframe contendo os dados de acidentes do ano
# SAIDA: Dataframe com data inversa convertida para formato lubridate e com as novas colunas: data_dia, data_mes, data_ano e data_semana
preparaData <- function(dados){
# A partir do formato de entrada converte para formato lubridate
dados$data_inversa <- lubridate::ymd(dados$data_inversa)
# Cria uma coluna que contém o dia do mês em que o acidente ocorreu
dados$data_dia <- lubridate::day(dados$data_inversa)
# Cria uma coluna que contém o mês do ano em que o acidente ocorreu
dados$data_mes <- lubridate::month(dados$data_inversa)
# Cria uma coluna que contém o ano em que o acidente ocorreu
dados$data_ano <- lubridate::year(dados$data_inversa)
# Cria data semana contendo o valor numérico do dia do mes em que o acidente ocorreu
dados$data_semana <- as.numeric(dados$data_dia)
# Divide os valores do dia do mes em intervalos de 7 dias
dados$data_semana <- cut(dados$data_semana,seq(0,35,7))
return(dados)
}
# Utiliza a funcao para formatar data e criar novas colunas
dados2017 <- preparaData(dados2017)
dados2018 <- preparaData(dados2018)
dados2019 <- preparaData(dados2019)Devido a alta quantidade de valores de dias, separemos este em mais um grupo, para ele ser mais interpretável. O novo grupo consistiu em agrupar os dias em bins de tamanho 7, logo, os dias de 0 até 7 são colocados em grupo, 8 até 14 em outro, e assim por diante. Chamamos este novo grupo de semanas. A seguir um grupo de gráficos foram plotados que contabilizam a distribuição de acidentes por dia, semana e mês.
Podemos começar analisando o comportamento da quantidade de acidentes ao longo dos anos. Para isto, elaboramos um mapa de calor em formato de calendário cuja cor reflete a quantidade de acidentes no dia com o passar dos anos. Para criar o mapa de calor foi necessário criar três data frames diferentes, um para cada ano. Iniciamos contabilizando os identificadores de acidentes distintos dentro de cada valor de data. Então criamos as várias de dia da semana, data/dia do mês, mês, semana, e semana do mês para criar o mapa de calor.
No gráfico, o ano e mês é utilizado para criar uma matriz de mapas de calor. Cada caixa dentro do mapa de calor representa um dia naquele mês/ano. No eixo horizontal representamos a semana do mês e no vertical representamos o dia da semana para aquele determinado dia. Ao passar o mouse por cima do dia, aparece as informações referente ao dia.
Este gráfico pode ser cruzado com datas de feriados e possíveis eventos que poderiam causar um elevado número de acidentes para identificar padrões de acidentes em datas específicas. No gráfico notamos que os tons de cores ficam mais escuros nos finais de semana (sexta-feira, sábado e domingo) que é um indicador de aumento de ocorrência de acidentes.
# Preparo de data frame para os dados de 2017 - Contabilizando os acidentes por data
aux1 <- as.data.frame(table(dados2017$data_inversa[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando o data frame
colnames(aux1) <- c("Data","Frequencia")
# Criando uma coluna que contém o dia da semana - ex: Segunda,terça, etc..
aux1$dia_Semana <- wday(ymd(aux1$Data),label = TRUE)
# Criando coluna que contém o dia do mes que o acidente ocorreu - ex: Dia 1o, 2o, etc.
aux1$data_mes <- day(ymd(aux1$Data))
# Criando coluna que contem o Mes em que o acidente ocorreu
aux1$mes <- month(ymd(aux1$Data),label = TRUE)
# Criando coluna que contem a semana do ano em que o acidete ocorreu
aux1$semana <- week(aux1$Data)
# Calculando a semana do mes com base na data, Varia de 1 ate 5
aux1$mes_semana <- as.integer((as.numeric(aux1$data_mes)-1)/7) + 1
# Preparo de data frame para os dados de 2018 - Contabilizando os acidentes por data
aux2 <- as.data.frame(table(dados2018$data_inversa[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando o data frame
colnames(aux2) <- c("Data","Frequencia")
# Criando uma coluna que contém o dia da semana - ex: Segunda,terça, etc..
aux2$dia_Semana <- wday(ymd(aux2$Data),label = TRUE)
# Criando coluna que contém o dia do mes que o acidente ocorreu - ex: Dia 1o, 2o, etc.
aux2$data_mes <- day(ymd(aux2$Data))
# Criando coluna que contem o Mes em que o acidente ocorreu
aux2$mes <- month(ymd(aux2$Data),label = TRUE)
# Criando coluna que contem a semana do ano em que o acidete ocorreu
aux2$semana <- week(aux2$Data)
# Calculando a semana do mes com base na data, Varia de 1 ate 5
aux2$mes_semana <- as.integer((as.numeric(aux2$data_mes)-1)/7) + 1
# Preparo de data frame para os dados de 2019 - Contabilizando os acidentes por data
aux3 <- as.data.frame(table(dados2019$data_inversa[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando o data frame
colnames(aux3) <- c("Data","Frequencia")
# Criando uma coluna que contém o dia da semana - ex: Segunda,terça, etc..
aux3$dia_Semana <- wday(ymd(aux3$Data),label = TRUE)
# Criando coluna que contém o dia do mes que o acidente ocorreu - ex: Dia 1o, 2o, etc.
aux3$data_mes <- day(ymd(aux3$Data))
# Criando coluna que contem o Mes em que o acidente ocorreu
aux3$mes <- month(ymd(aux3$Data),label = TRUE)
# Criando coluna que contem a semana do ano em que o acidete ocorreu
aux3$semana <- week(aux3$Data)
# Calculando a semana do mes com base na data, Varia de 1 ate 5
aux3$mes_semana <- as.integer((as.numeric(aux3$data_mes)-1)/7) + 1
# Uniao dos data frames
aux <- rbind(aux1,aux2,aux3)
# Reordenando os niveis do dia da semana
aux$dia_Semana <- factor(aux$dia_Semana,c("dom","sáb","sex","qui","qua","ter","seg"))
# Renomeando as colunas
colnames(aux) <- c("Data","Acidentes","Dia_Semana","Dia_Data","Mes","Semana","Mes_Semana")
# Plotando o grafio
p <- ggplot(aux, aes(x = Mes_Semana, y = Dia_Semana, fill = Acidentes, text = paste("Dia: ",Dia_Data))) +
geom_tile(colour = "white") +
facet_grid(year(aux$Data)~Mes) +
scale_fill_gradient(low="#D5D8DC", high="#D60000") +
xlab("Semana do Mês") +
ylab("") +
ggtitle("Mapa de Calor: Calendário para Acidentes") +
labs(fill = "Acidentes") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p)Este atributo, devido a alta quantidade de valores distintos, se torna bem difícil de analisar neste gráfico. Por isto, similar a análise de trecho de quilômetros, optamos por utilizar um gráfico de linhas preenchido por questões estéticas e de interpretabilidade.
Durante o decorrer do mês não conseguimos observar nenhum padrão específico. No final do mês, observa-se uma queda na quantidade de acidentes. Isto pode ser explicado pois alguns meses são menores do que o outro. Além do que foi citado não observamos nenhum padrão específico de aumento ou declínio de acidentes.
# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux1 <- as.data.frame(table(dados2017$data_dia[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Dia_Mes","Quantidade")
# Transformando o dia do mes em um valor numérico para conseguir plotar o gráfico
aux1$Dia_Mes <- as.numeric(aux1$Dia_Mes)
# Plotando o grafico de linhas
p1 <- aux1 %>%
ggplot(aes(x = Dia_Mes, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("a) Dia do mês dos acidentes (2017)") +
xlab("Dia") +
ylab("Acidentes")
ggplotly(p1)# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux2 <- as.data.frame(table(dados2018$data_dia[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Dia_Mes","Quantidade")
# Transformando o dia do mes em um valor numérico para conseguir plotar o gráfico
aux2$Dia_Mes <- as.numeric(aux2$Dia_Mes)
# Plotando o grafico de linhas
p2 <- aux2 %>%
ggplot(aes(x = Dia_Mes, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("b) Dia do mês dos acidentes (2018)") +
xlab("Dia") +
ylab("Acidentes")
ggplotly(p2)# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux3 <- as.data.frame(table(dados2019$data_dia[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Dia_Mes","Quantidade")
# Transformando o dia do mes em um valor numérico para conseguir plotar o gráfico
aux3$Dia_Mes <- as.numeric(aux3$Dia_Mes)
# Plotando o grafico de linhas
p3 <- aux3 %>%
ggplot(aes(x = Dia_Mes, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("c) Dia do mês dos acidentes (2019)") +
xlab("Dia") +
ylab("Acidentes")
ggplotly(p3)# Criando as colunas de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Combinando os dataframes
aux <- rbind(aux1,aux2,aux3)
aux$Ano <- as.factor(aux$Ano)
# Plotando o grafico de linhas
p1 <- aux %>%
ggplot(aes(x = Dia_Mes, y = Quantidade, color = Ano, group = Ano)) +
geom_point() +
geom_line() +
ggtitle("d) Dia do mês dos acidentes") +
xlab("Dia") +
ylab("Acidentes") +
theme(axis.text.x=element_blank()) +
scale_color_viridis(discrete = TRUE)
ggplotly(p1)A distribuição de acidentes por semana parece ser razoavelmente uniforme. Algo a se notar é que o 5º grupo possui uma quantidade menor de acidentes durante todos os anos, mas isto é porquê ele possui menos dias do que as outras semanas (apenas os dias 29,30 e 31).
# Contabilizando a quantidade de acidentes por semana
aux1 <- as.data.frame(table(dados2017$data_semana[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Semana_Mes","Quantidade")
# Plotando o o grafico
p1 <- ggplot(aux1, aes(x = Semana_Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Semana_Mes)) +
ggtitle("a) Semana do mês dos acidentes (2017)") +
xlab("Semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando a quantidade de acidentes por semana
aux2 <- as.data.frame(table(dados2018$data_semana[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Semana_Mes","Quantidade")
# Plotando o o grafico
p2 <- ggplot(aux2, aes(x = Semana_Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Semana_Mes)) +
ggtitle("b) Semana do mês dos acidentes (2018)") +
xlab("Semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p2)# Contabilizando a quantidade de acidentes por semana
aux3 <- as.data.frame(table(dados2019$data_semana[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Semana_Mes","Quantidade")
# Plotando o o grafico
p3 <- ggplot(aux3, aes(x = Semana_Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Semana_Mes)) +
ggtitle("c) Semana do mês dos acidentes (2017)") +
xlab("Semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p3)# Adicionando a coluna de ano aos dataframes
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Realizando a uniao entre os data frames
aux <- rbind(aux1,aux2,aux3)
# Reordenando a semana por quantiidade descrescente de acidentes
aux$Semana_Mes <- with(aux, reorder(Semana_Mes, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Semana_Mes, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Semana do mês dos acidentes (2017 - 2019)") +
xlab("Semana") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
scale_fill_discrete(name = "Dia da semana") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Semana_Mes, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Semana do mês dos acidentes (2017 - 2019)") +
xlab("Semana") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Analisando este conjunto de gráficos, vemos nos anos de 2019 e 2017 que dezembro parece ser o mês com maior concentração de acidentes. O ano se de 2018 já é diferente, em que janeiro se apresentou como maior concentração de acidentes.
# Contabilizando a quantidade de acidentes para cada mes
aux1 <- as.data.frame(table(dados2017$data_mes[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Mes","Quantidade")
# Plotando o grafico de barras
p1 <- ggplot(aux1, aes(x = Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Mes)) +
ggtitle("a) Mês dos acidentes (2017)") +
xlab("Mês") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando a quantidade de acidentes para cada mes
aux2 <- as.data.frame(table(dados2018$data_mes[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Mes","Quantidade")
# Plotando o grafico de barras
p2 <- ggplot(aux2, aes(x = Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Mes)) +
ggtitle("b) Mês dos acidentes (2018)") +
xlab("Mês") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p2)# Contabilizando a quantidade de acidentes para cada mes
aux3 <- as.data.frame(table(dados2019$data_mes[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Mes","Quantidade")
# Plotando o grafico de barras
p3 <- ggplot(aux3, aes(x = Mes, y = Quantidade)) +
geom_bar(stat = "identity",aes(fill = Mes)) +
ggtitle("c) Mês dos acidentes (2019)") +
xlab("Mês") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p3)# Adicionando as colunas de ano aos dataframes
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando dataframe com a uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando o dataframe com base na quantidade de acidentes
aux$Mes <- with(aux, reorder(Mes, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Mes, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Mês dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Mes, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Mês dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “horario” no nosso dataset contém aproximadamente o horário que o acidente ocorreu ou foi registrado (o dicionário de atributos diz apenas ocorrência), com intervalos de minuto a minuto. Devido a alta quantidade de intervalos que o atributo horário possui, optamos por utilizar um gráfico de linhas para visualizar o horário em que os acidentes ocorrem. Foi necessário reagrupar os horários utilizando intervalos de 30 em 30 minutos para o gráfico ficar mais interpretável.
Notamos dois intervalos de pico principais que são por volta das 07:30 e outro maior ainda por volta das 18:30. Pensando em um contexto de uma grande metrópole, isto faz sentido pois é horário tradicional que as rodovias estão sobrecarregadas. Ao longo dos três anos, não enxergamos nenhuma mudança significativa nos padrões de acidentes.
# Concatenando e Convertando data-hora para formato lubridate
aux <- lubridate::ymd_hms(paste(dados2017$data_inversa,dados2017$horario))
# Reagrupando em intervalos de 30 em 30 minutos
aux <- lubridate::round_date(aux,"30 minutes")
# Convertando para formato de caractere para plotagem
aux <- as.data.frame(as.character(format(aux,"%H:%M")))
# Renomeando a coluna
colnames(aux) <- c("horario")
# Adicionando coluna de ID para fazer a contagem de acidentes
aux$id <- dados2017$id
# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux1 <- as.data.frame(table(aux$horario[!duplicated(aux$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Horario","Quantidade")
# Plotando o grafico de linhas
p1 <- aux1 %>%
ggplot(aes(x = Horario, y = Quantidade, group = 1)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("a) Horario dos acidentes agrupados por 30 minutos (2017)") +
xlab("Horario") +
ylab("Acidentes") +
scale_x_discrete(breaks = c("00:00","06:00","12:00","18:00"))
ggplotly(p1)# Concatenando e Convertando data-hora para formato lubridate
aux <- lubridate::ymd_hms(paste(dados2018$data_inversa,dados2018$horario))
# Reagrupando em intervalos de 30 em 30 minutos
aux <- lubridate::round_date(aux,"30 minutes")
# Convertando para formato de caractere para plotagem
aux <- as.data.frame(as.character(format(aux,"%H:%M")))
# Renomeando a coluna
colnames(aux) <- c("horario")
# Adicionando coluna de ID para fazer a contagem de acidentes
aux$id <- dados2018$id
# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux2 <- as.data.frame(table(aux$horario[!duplicated(aux$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Horario","Quantidade")
# Plotando o grafico de linhas
p2 <- aux2 %>%
ggplot(aes(x = Horario, y = Quantidade, group = 1)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("b) Horario dos acidentes agrupados por 30 minutos (2018)") +
xlab("Horario") +
ylab("Acidentes") +
scale_x_discrete(breaks = c("00:00","06:00","12:00","18:00"))
ggplotly(p2)# Concatenando e Convertando data-hora para formato lubridate
aux <- lubridate::ymd_hms(paste(dados2019$data_inversa,dados2019$horario))
# Reagrupando em intervalos de 30 em 30 minutos
aux <- lubridate::round_date(aux,"30 minutes")
# Convertando para formato de caractere para plotagem
aux <- as.data.frame(as.character(format(aux,"%H:%M")))
# Renomeando a coluna
colnames(aux) <- c("horario")
# Adicionando coluna de ID para fazer a contagem de acidentes
aux$id <- dados2019$id
# Contabilizando o numero de identificadores de acidentes distintos por dia do mês
aux3 <- as.data.frame(table(aux$horario[!duplicated(aux$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Horario","Quantidade")
# Plotando o grafico de linhas
p3 <- aux3 %>%
ggplot(aes(x = Horario, y = Quantidade, group = 1)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("c) Horario dos acidentes agrupados por 30 minutos (2019)") +
xlab("Horario") +
ylab("Acidentes") +
scale_x_discrete(breaks = c("00:00","06:00","12:00","18:00"))
ggplotly(p3)# Criando as colunas de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Combinando os dataframes
aux <- rbind(aux1,aux2,aux3)
aux$Ano <- as.factor(aux$Ano)
# Plotando o grafico de linhas
p1 <- aux %>%
ggplot(aes(x = Horario, y = Quantidade, color = Ano, group = Ano)) +
geom_point() +
geom_line() +
ggtitle("d) Horario dos acidentes agrupados por 30 minutos (2017-2019)") +
xlab("Horario") +
ylab("Acidentes") +
scale_x_discrete(breaks = c("00:00","06:00","12:00","18:00")) +
scale_color_viridis(discrete = TRUE)
ggplotly(p1)O atributo “fase_dia” contém a fase do dia no momento do acidente. A quantidade de acidentes nas fases de transição é menor do que as fases “plenas”. Isto pode indicar que as janelas de tempo entre eles são de tamanhos diferentes. As proporções ao longo dos anos são bem-parecidas, e não enxergamos nenhuma mudança que vale comentar. No geral faz sentido a maioria dos acidentes ocorrerem durante a fase “Pleno Dia” pois parece ser na janela de tempo que tradicionalmente as pessoas optam para se deslocar.
# Contabilizando a quantidade de acidentes unicos por fase do dia
aux1 <- as.data.frame(table(dados2017$fase_dia[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeia as colunas ja que a funcao table() muda os nomes
colnames(aux1) <- c("Fase_Dia","Quantidade")
# Reordena os levels de fase dia para organizar a figura
aux1$Fase_Dia <- factor(aux1$Fase_Dia,c("Amanhecer","Pleno dia","Anoitecer","Plena Noite"))
# Criacao da figura
p1 <- ggplot(aux1, aes(x = Fase_Dia, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Fase_Dia)) +
ggtitle("a) Fase do dia dos acidentes (2017)") +
xlab("Fase do dia") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando a quantidade de acidentes unicos por fase do dia
aux2 <- as.data.frame(table(dados2018$fase_dia[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeia as colunas ja que a funcao table() muda os nomes
colnames(aux2) <- c("Fase_Dia","Quantidade")
# Reordena os levels de fase dia para organizar a figura
aux2$Fase_Dia <- factor(aux2$Fase_Dia,c("Amanhecer","Pleno dia","Anoitecer","Plena Noite"))
# Criacao da figura
p2 <- ggplot(aux2, aes(x = Fase_Dia, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Fase_Dia)) +
ggtitle("b) Fase do dia dos acidentes (2018)") +
xlab("Fase do dia") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p2)# Contabilizando a quantidade de acidentes unicos por fase do dia
aux3 <- as.data.frame(table(dados2019$fase_dia[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeia as colunas ja que a funcao table() muda os nomes
colnames(aux3) <- c("Fase_Dia","Quantidade")
# Reordena os levels de fase dia para organizar a figura
aux3$Fase_Dia <- factor(aux3$Fase_Dia,c("Amanhecer","Pleno dia","Anoitecer","Plena Noite"))
# Criacao da figura
p3 <- ggplot(aux2, aes(x = Fase_Dia, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Fase_Dia)) +
ggtitle("c) Fase do dia dos acidentes (2019)") +
xlab("Fase do dia") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p3)# Adiciona a coluna de ano para os tres data frames separados
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Uniao de dataframes e reordenacao por quantidade decrescente
aux <- rbind(aux1,aux2,aux3)
aux$Fase_Dia <- with(aux, reorder(Fase_Dia, Quantidade, median))
# Criando o grafico
p1 <- ggplot(aux, aes(fill=Fase_Dia, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Fase do dia dos acidentes (2017 - 2019)") +
xlab("Fase do dia") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Criando o grafico
p1 <- ggplot(aux, aes(fill=Fase_Dia, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Fase do dia dos acidentes (2017 - 2019)") +
xlab("Fase do dia") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “condicao_metereologica” diz qual era a condição meteorológica no momento do acidente. Este atributo é nominal mas pode ser transformado em um atributo ordinal criando uma escala de quão “ruim” o tempo era no momento de acidente. Especialmente na análise de regras de associação, este atributo pode gerar resultados muito interessantes, que permitem avaliar como as condições climáticas afetam os acidentes. Nos gráficos plotados, o que analisamos é uma ordem fixa na condição dos acidentes registrados. Analisando o gráfico de proporções, vemos que as quantidades de acidentes registrados no sol aumentaram bem, enquanto os na chuva caíram.
# Contabilizando a quantidade de acidentes por condicao metereologica
aux1 <- as.data.frame(table(dados2017$condicao_metereologica[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() modifica o nome das colunas
colnames(aux1) <- c("Condicao","Quantidade")
# Reordenando o data frame para gerar grafico por condicao com quantidade decrescente
aux1$Condicao <- with(aux1, reorder(Condicao,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Condicao, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Condicao)) +
ggtitle("a) Condição meteorológica durante os acidentes (2017)") +
xlab("Condição") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando a quantidade de acidentes por condicao metereologica
aux2 <- as.data.frame(table(dados2018$condicao_metereologica[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() modifica o nome das colunas
colnames(aux2) <- c("Condicao","Quantidade")
# Reordenando o data frame para gerar grafico por condicao com quantidade decrescente
aux2$Condicao <- with(aux2, reorder(Condicao,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Condicao, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Condicao)) +
ggtitle("b) Condição meteorológica durante os acidentes (2018)") +
xlab("Condição") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando a quantidade de acidentes por condicao metereologica
aux3 <- as.data.frame(table(dados2019$condicao_metereologica[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() modifica o nome das colunas
colnames(aux3) <- c("Condicao","Quantidade")
# Reordenando o data frame para gerar grafico por condicao com quantidade decrescente
aux3$Condicao <- with(aux3, reorder(Condicao,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Condicao, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Condicao)) +
ggtitle("c) Condição meteorológica durante os acidentes (2019)") +
xlab("Condição") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Criando as colunas de ano nos dataframes
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenacao para gerar grafico ordenado por quantidade decrescente
aux$Condicao <- with(aux, reorder(Condicao, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Condicao, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Condição meteorológica durante os acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Condicao, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Condição meteorológica durante os acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “causa_acidente” indica qual foi o principal motivo documentado que causou o acidente. Este atributo gera valores bem longos, que são puramente nominais, então elaboramos uma função para substituir alguns valores que devido ao seu tamanho, atrapalhavam a elaboração de gráficos. Apenas um único valor foi renomeado com a função a baixo.
# ENTRADA: O dataframe contendo os dados do ano referente
# SAIDA: O mesmo dataframe, desta vez com a coluna de causa acidente com alguns valores renomeados
resumeDescricaoCausas <- function(dados){
levels(dados$causa_acidente) <- c(levels(dados$causa_acidente),
"Defeito de iluminação/sinalização no veículo",
"Uso de entorpercentes pelo pedestre",
"Desobediência às normas de trânsito (condutor)",
"Desobediência às normas de trânsito (pedestre)")
dados$causa_acidente[dados$causa_acidente == "Deficiência ou não Acionamento do Sistema de Iluminação/Sinalização do Veículo"
] <- "Defeito de iluminação/sinalização no veículo"
dados$causa_acidente[dados$causa_acidente == "Ingestão de álcool e/ou substâncias psicoativas pelo pedestre"
] <- "Uso de entorpercentes pelo pedestre"
dados$causa_acidente[dados$causa_acidente == "Desobediência às normas de trânsito pelo condutor"
] <- "Desobediência às normas de trânsito (condutor)"
dados$causa_acidente[dados$causa_acidente == "Desobediência às normas de trânsito pelo pedestre"
] <- "Desobediência às normas de trânsito (pedestre)"
dados$causa_acidente <- droplevels(dados$causa_acidente)
return(dados)
}Sobre como os valores são distribuídos o que observamos é que a grande maioria dos acidentes são registrados como causados por falta de atenção. Em 2017, a segunda maior causa de acidentes é velocidade incompatível, porém, isto não se mantem para os outros dois anos posteriores, onde a segunda maior causa de acidentes é desobediência às normas de trânsito pelo condutor. Além destes, vemos que a velocidade incompatível e ingestão de álcool também lideram como causas de acidentes. Olhando o gráfico de proporções, com o passar dos anos a porcentagem de acidentes registrados por falta de atenção diminui, enquanto de 2017 para 2018 a quantidade de acidentes como desobediência de normas de trânsito dobram, e a quantidade de acidentes por velocidade incompatível diminui.
# Substituindo alguns valores de causa acidente
dados2017 <- resumeDescricaoCausas(dados2017)
# Contabilizando a quantidade de acidentes por causa
aux1 <- as.data.frame(table(dados2017$causa_acidente[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda os nomes
colnames(aux1) <- c("Causa","Quantidade")
# Reordenando as causas com base na quantidade de acidentes
aux1$Causa <- with(aux1, reorder(Causa,Quantidade,median))
# Criando o grafico
p1 <- ggplot(aux1, aes(x = Causa, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Causa)) +
ggtitle("a) Causa principal dos acidentes (2017)") +
xlab("Causa") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Substituindo alguns valores de causa acidente
dados2018 <- resumeDescricaoCausas(dados2018)
# Contabilizando a quantidade de acidentes por causa
aux2 <- as.data.frame(table(dados2018$causa_acidente[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda os nomes
colnames(aux2) <- c("Causa","Quantidade")
# Reordenando as causas com base na quantidade de acidentes
aux2$Causa <- with(aux2, reorder(Causa,Quantidade,median))
# Criando o grafico
p1 <- ggplot(aux2, aes(x = Causa, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Causa)) +
ggtitle("b) Causa principal dos acidentes (2018)") +
xlab("Causa") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Substituindo alguns valores de causa acidente
dados2019 <- resumeDescricaoCausas(dados2019)
# Contabilizando a quantidade de acidentes por causa
aux3 <- as.data.frame(table(dados2019$causa_acidente[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas ja que a funcao table() muda os nomes
colnames(aux3) <- c("Causa","Quantidade")
# Reordenando as causas com base na quantidade de acidentes
aux3$Causa <- with(aux3, reorder(Causa,Quantidade,median))
# Criando o grafico
p1 <- ggplot(aux3, aes(x = Causa, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Causa)) +
ggtitle("c) Causa principal dos acidentes (2019)") +
xlab("Causa") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando a coluna de ano nos data frames
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando a uniaoo dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando para plotar por causa decrescente
aux$Causa <- with(aux, reorder(Causa, Quantidade, median))
# Criando o grafico
p1 <- ggplot(aux, aes(fill=Causa, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Causa principal dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Criando o grafico
p1 <- ggplot(aux, aes(fill=Causa, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Causa principal dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo correspondente a tipo de acidente é um atributo nominal, indicado por “tipo_acidente” e descreve a forma que o acidente ocorreu. A grande maioria dos tipos relata algum tipo de colisão. O tipo que mais predomina é o de colisão traseira, seguido por saída da pista. Na realidade, os acidentes geralmente envolvem uma sequência destes tipos, mas neste data set, é relatado o tipo principal. Ao longo dos anos, apesar das quantidades variarem, as proporções se mantém sem grandes mudanças em suas distribuições. Este atributo pode ser interessante para a interpretação de regras, pois tipos diferentes de acidentes podem mudar completamente as consequências do acidente.
# Contabilizando os acidentes por tipo
aux1 <- as.data.frame(table(dados2017$tipo_acidente[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Tipo","Quantidade")
# Reordenado por quantidade decrescente de acidentes por tipo
aux1$Tipo <- with(aux1, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("a) Tipo dos acidentes (2017)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os acidentes por tipo
aux2 <- as.data.frame(table(dados2018$tipo_acidente[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Tipo","Quantidade")
# Reordenado por quantidade decrescente de acidentes por tipo
aux2$Tipo <- with(aux2, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("b) Tipo dos acidentes (2018)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os acidentes por tipo
aux3 <- as.data.frame(table(dados2019$tipo_acidente[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Tipo","Quantidade")
# Reordenado por quantidade decrescente de acidentes por tipo
aux3$Tipo <- with(aux3, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("c) Tipo dos acidentes (2019)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando a coluna de ano aos dataframes
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando a uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando os tipos com base na quantidade de acidentes
aux$Causa <- with(aux, reorder(Tipo, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Tipo dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Tipo dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)É interessante analisar o atributo de ano de fabricação, pois pode ser que se encontra algum padrão nas classificações dos acidentes. Veículos mais novos possuem cada vez mais dispositivos de segurança, e pode ser, que veículos mais antigos venham a ter mais falhas mecânicas e elétricas. O Atributo “ano_fabricacao_veiculo” indica as informações do veículo acidentado. Apesar de um numero até um pouco alto de valores distintos, pelo fato dos anos estarem concentrados em torno de valores mais recentes, não realizamos nenhum agrupamento de valores numéricos. Analisando rapidamente entre os gráficos de cada ano, os padrões de ter mais veículos em certos anos (1997, 2011 e 2013) parecem se manter, mesmo com o passar dos anos. Este atributo possui valores ausentes, porém, como no caso do “KM”, optamos por realizar a substituição após plotar os gráficos, no caso pelo valor “Não Informado”.
# Calculando a quantidade de veiculos por ano de fabricacao
aux1 <- as.data.frame(table(dados2017$ano_fabricacao_veiculo[!duplicated(dados2017$id_veiculo)]))
# Renomeando as colunas
colnames(aux1) <- c("Ano_Fab","Quantidade")
# Converte de factor para string (conversao direta para numerico da erro)
aux1$Ano_Fab <- as.character(aux1$Ano_Fab)
# Conversao de string para numerico para plotar o grafico
aux1$Ano_Fab <- as.numeric(aux1$Ano_Fab)
# Plotando o grafico de linhas
p1 <- aux1 %>%
ggplot(aes(x = Ano_Fab, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("a) Veículos acidentados por ano de fabricação (2017)") +
xlab("Ano de fabricação") +
ylab("Veículos") +
theme(axis.text.x=element_blank())
ggplotly(p1) # Calculando a quantidade de veiculos por ano de fabricacao
aux2 <- as.data.frame(table(dados2018$ano_fabricacao_veiculo[!duplicated(dados2018$id_veiculo)]))
# Renomeando as colunas
colnames(aux2) <- c("Ano_Fab","Quantidade")
# Converte de factor para string (conversao direta para numerico da erro)
aux2$Ano_Fab <- as.character(aux2$Ano_Fab)
# Conversao de string para numerico para plotar o grafico
aux2$Ano_Fab <- as.numeric(aux2$Ano_Fab)
# Plotando o grafico de linhas
p2 <- aux2 %>%
ggplot(aes(x = Ano_Fab, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("b) Veículos acidentados por ano de fabricação (2018)") +
xlab("Ano de fabricação") +
ylab("Veículos") +
theme(axis.text.x=element_blank())
ggplotly(p2) # Calculando a quantidade de veiculos por ano de fabricacao
aux3 <- as.data.frame(table(dados2019$ano_fabricacao_veiculo[!duplicated(dados2019$id_veiculo)]))
# Renomeando as colunas
colnames(aux3) <- c("Ano_Fab","Quantidade")
# Converte de factor para string (conversao direta para numerico da erro)
aux3$Ano_Fab <- as.character(aux3$Ano_Fab)
# Conversao de string para numerico para plotar o grafico
aux3$Ano_Fab <- as.numeric(aux3$Ano_Fab)
# Plotando o grafico de linhas
p3 <- aux3 %>%
ggplot(aes(x = Ano_Fab, y = Quantidade)) +
geom_area(fill="#69b3a2", alpha=0.5) +
geom_line(color="#69b3a2") +
geom_point(color = "#69b3a2") +
ggtitle("c) Veículos acidentados por ano de fabricação (2019)") +
xlab("Ano de fabricação") +
ylab("Veículos") +
theme(axis.text.x=element_blank())
ggplotly(p3) # Criando as colunas de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Combinando os dataframes
aux <- rbind(aux1,aux2,aux3)
aux$Ano <- as.factor(aux$Ano)
# Plotando o grafico de linhas
p1 <- aux %>%
ggplot(aes(x = Ano_Fab, y = Quantidade, color = Ano, group = Ano)) +
geom_point() +
geom_line() +
ggtitle("d) Veículos acidentados por ano de fabricação (2017 - 2019)") +
xlab("Ano de fabricação") +
ylab("Veículos") +
theme(axis.text.x=element_blank()) +
scale_color_viridis(discrete = TRUE)
ggplotly(p1)# ENTRADA: Dataframe contendo os dados de acidente do ano
# SAIDA: Dataframe com ano de fabricacao transformado em factor e NA substituido por Nao Informado
preparaAnoFabricacao <- function(dados){
dados$ano_fabricacao_veiculo <- as.factor(dados$ano_fabricacao_veiculo)
levels(dados$ano_fabricacao_veiculo) <- c(levels(dados$ano_fabricacao_veiculo), "Não Informado")
dados$ano_fabricacao_veiculo[which(is.na(dados$ano_fabricacao_veiculo))] <- "Não Informado"
dados$ano_fabricacao_veiculo <- droplevels(dados$ano_fabricacao_veiculo)
return(dados)
}
dados2017 <- preparaAnoFabricacao(dados2017)
dados2018 <- preparaAnoFabricacao(dados2018)
dados2019 <- preparaAnoFabricacao(dados2019)O atributo “marca” identifica o fabricante e modelo do veículo na maioria dos casos. Como o atributo identifica o modelo, o atributo possui uma quantidade muito grande de valores distintos. Este atributo possui valores ausentes, então devemos substituir estes por “Não Informado”. Deixamos para fazer isto depois de plotar os gráficos devido a não compatibilidade da biblioteca com o caractere com acento.
Analisar um atributo com tantos valores distintos se torna inviável de se realizar com gráficos de barras, então optamos por utilizar um Wordcloud para destacar as 100 palavras mais repetidas dentro do conjunto de marcas/modelos de veículos por ano. As palavras mais centralizadas e com tamanho de fonte maior possuem mais repetições.
Analisando os Wordclouds se torna fácil de identificar que a predominância é de veículos populares, onde a maioria das palavras que mais ocorrem podem ser relacionadas a modelo de motocicletas, e conforme se distancia do centro do gráfico, se observa que as palavras associadas a carros populares começam a se destacar, e por ultimo palavras relacionadas a carros não tão populares e caminhões aparecem.
# Funcao da biblioteca wordcloud para plotagem
wordcloud(dados2017$marca[!duplicated(dados2017$id_veiculo)],
random.order=FALSE,
max.words=100,
colors=brewer.pal(8,"Dark2"))# Funcao da biblioteca wordcloud para plotagem
wordcloud(dados2018$marca[!duplicated(dados2018$id_veiculo)],
random.order=FALSE,
max.words=100,
colors=brewer.pal(8,"Dark2"))# Funcao da biblioteca wordcloud para plotagem
wordcloud(dados2019$marca[!duplicated(dados2019$id_veiculo)],
random.order=FALSE,
max.words=100,
colors=brewer.pal(8,"Dark2"))# ENTRADA: Dataframe da base de dados de acidentes
# SAIDA: Dataframe da base de dados com valores NA substituidos por Nao Informado na coluna de marca
preparaMarca <- function(dados){
levels(dados$marca) <- c(levels(dados$marca),"Não Informado")
dados$marca[which(is.na(dados$marca))] <- "Não Informado"
return(dados)
}
dados2017 <- preparaMarca(dados2017)
dados2018 <- preparaMarca(dados2018)
dados2019 <- preparaMarca(dados2019)O atributo “tipo_veiculo” existe para fornecer uma informação mais genérica sobre os veículos acidentados. Elaboramos gráficos de barras para analisar como são distribuídos as frequências de tipos de veículos acidentados. Como este atributo possui valores ausentes, precisamos preparar os dados realizando a substituição destes valores.
# ENTRADA: Data frame com base de dados de acidentes do ano
# SAIDA: Dataframe com coluna de tipo veiculo com valores NA substituidos por Nao Informado
preparaTipoVeiculo <- function(dados){
levels(dados$tipo_veiculo) <- c(levels(dados$tipo_veiculo), "Não Informado")
dados$tipo_veiculo[which(is.na(dados$tipo_veiculo))] <- "Não Informado"
dados$tipo_veiculo <- droplevels(dados$tipo_veiculo)
return(dados)
}
dados2017 <- preparaTipoVeiculo(dados2017)
dados2018 <- preparaTipoVeiculo(dados2018)
dados2019 <- preparaTipoVeiculo(dados2019)De cara, algo interessante que aparece é que apesar do Wordcloud sobre a marca/modelo dos veículos mostrar que a Honda CG é um dos modelos que mais se repetem, a quantidade de automóveis envolvidos em acidentes é mais que o dobro das motocicletas. O que pode explicar isto é que dentro dos acidentes de motocicletas, há predominância de um único modelo, enquanto nos automóveis há uma maior diversidade de modelos. Analisando o gráfico de proporções, podemos observar que as quantidades de motocicletas aumentam bastante com o passar dos anos, enquanto a maioria dos outros tipos caem.
# Contabilizando os veiculos por cada tipo
aux1 <- as.data.frame(table(dados2017$tipo_veiculo[!duplicated(dados2017$id_veiculo)],useNA = "ifany"))
# Substituindo os valores ausentes
levels(aux1$Var1) <- c(levels(aux1$Var1),"Não Informado")
aux1$Var1[is.na(aux1$Var1)] <- "Não Informado"
# Renomeando as colunas pois a funcao table altera os nomes
colnames(aux1) <- c("Tipo","Quantidade")
# Reordenado os tipos de veiculos com base na quantidade
aux1$Tipo <- with(aux1, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("a) Tipo de veículos envolvidos em acidentes (2017)") +
xlab("Tipo") +
ylab("Quantidade") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os veiculos por cada tipo
aux2 <- as.data.frame(table(dados2018$tipo_veiculo[!duplicated(dados2018$id_veiculo)],useNA = "ifany"))
# Substituindo os valores ausentes
levels(aux2$Var1) <- c(levels(aux2$Var1),"Não Informado")
aux2$Var1[is.na(aux2$Var1)] <- "Não Informado"
# Renomeando as colunas pois a funcao table altera os nomes
colnames(aux2) <- c("Tipo","Quantidade")
# Reordenado os tipos de veiculos com base na quantidade
aux2$Tipo <- with(aux2, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("b) Tipo de veículos envolvidos em acidentes (2018)") +
xlab("Tipo") +
ylab("Quantidade") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando os veiculos por cada tipo
aux3 <- as.data.frame(table(dados2019$tipo_veiculo[!duplicated(dados2019$id_veiculo)],useNA = "ifany"))
# Substituindo os valores ausentes
levels(aux3$Var1) <- c(levels(aux3$Var1),"Não Informado")
aux3$Var1[is.na(aux3$Var1)] <- "Não Informado"
# Renomeando as colunas pois a funcao table altera os nomes
colnames(aux3) <- c("Tipo","Quantidade")
# Reordenado os tipos de veiculos com base na quantidade
aux3$Tipo <- with(aux3, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("c) Tipo de veículos envolvidos em acidentes (2019)") +
xlab("Tipo") +
ylab("Quantidade") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando a coluna de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando dataframe com a uniao dos dataframes de cada ano
aux <- rbind(aux1,aux2,aux3)
# Reordenando por quantidade de veiculos por tipo
aux$Causa <- with(aux, reorder(Tipo, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Tipo de veículos envolvidos em acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Quantidade") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Tipo de veículos envolvidos em acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Quantidade") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “tracado_via” identifica a forma física da rodovia onde ocorreu o acidente. Este atributo é importante pois pode ser que diferentes traçados possuem diferentes características de acidentes. Há ocorrência de valores ausentes, logo precisamos criar uma função que realize a substituição desses valores.
# ENTRADA: Dataframe da base com acidentes
# SAIDA: Dataframe com coluna de tracado via com NA substituido por Nao Informado
preparaTracado <- function(dados){
levels(dados$tracado_via) <- c(levels(dados$tracado_via),"Não Informado")
dados$tracado_via[is.na(dados$tracado_via)] <- "Não Informado"
dados$tracado_via <- droplevels(dados$tracado_via)
return(dados)
}
dados2017 <- preparaTracado(dados2017)
dados2018 <- preparaTracado(dados2018)
dados2019 <- preparaTracado(dados2019)Após realizar esta substituição, podemos plotar gráficos de barras para visualizar como este atributo se comporta. Algo notável é que a quantidade de acidentes que ocorrem em retas é muito maior do que qualquer outro traçado. Analisando os valores com o passar dos anos, pode se perceber um crescimento em acidentes que ocorrem em retas e menor quantidade de ocorrências em curvas. Os outros valores ocorrem em quantidade significativamente menos comum.
Este atributo pode se tornar muito interessante para interpretar como o traçado afeta a gravidade do acidente. Pode ser que nas retas os acidentes sejam mais graves devido ao excesso de velocidade. Por outro lado, não podemos descartar que acidentes em curvas são tradicionalmente vistos como muito perigosos. Para os demais valores podem surgir padrões muito interessantes. Um risco é que devido a baixa quantidade de ocorrências, estes padrões surjam por coincidência.
# Contabilizando quantidade de acidentes por tipo de tracado
aux1 <- as.data.frame(table(dados2017$tracado_via[!duplicated(dados2017$id)],useNA = "ifany"))
# Substituindo valores ausentes
levels(aux1$Var1) <- c(levels(aux1$Var1),"Não Informado")
aux1$Var1[is.na(aux1$Var1)] <- "Não Informado"
# Renomeando as colunas
colnames(aux1) <- c("Tracado","Quantidade")
# Reordenando por quantidade de acidentes por tracado
aux1$Tracado <- with(aux1, reorder(Tracado,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Tracado, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tracado)) +
ggtitle("a) Traçado da pista dos acidentes (2017)") +
xlab("Tracado") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando quantidade de acidentes por tipo de tracado
aux2 <- as.data.frame(table(dados2018$tracado_via[!duplicated(dados2018$id)],useNA = "ifany"))
# Substituindo valores ausentes
levels(aux2$Var1) <- c(levels(aux2$Var1),"Não Informado")
aux2$Var1[is.na(aux2$Var1)] <- "Não Informado"
# Renomeando as colunas
colnames(aux2) <- c("Tracado","Quantidade")
# Reordenando por quantidade de acidentes por tracado
aux2$Tracado <- with(aux2, reorder(Tracado,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Tracado, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tracado)) +
ggtitle("b) Traçado da pista dos acidentes (2018)") +
xlab("Tracado") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando quantidade de acidentes por tipo de tracado
aux3 <- as.data.frame(table(dados2019$tracado_via[!duplicated(dados2019$id)],useNA = "ifany"))
# Substituindo valores ausentes
levels(aux3$Var1) <- c(levels(aux3$Var1),"Não Informado")
aux3$Var1[is.na(aux3$Var1)] <- "Não Informado"
# Renomeando as colunas
colnames(aux3) <- c("Tracado","Quantidade")
# Reordenando por quantidade de acidentes por tracado
aux3$Tracado <- with(aux3, reorder(Tracado,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Tracado, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tracado)) +
ggtitle("c) Traçado da pista dos acidentes (2019)") +
xlab("Tracado") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# ADicionando a coluna de anos aos dataframes
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando por quantidade de acidentes por tracado
aux$Causa <- with(aux, reorder(Tracado, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tracado, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Traçado da pista dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tracado, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Traçado da pista dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “tipo_pista” identifica a quantidade de faixas que cada mão que da via possui. Este atributo não possui valores ausentes. Para sua visualização utilizamos um gráfico de barras. A quantidades de cada tipo por si só apenas refletem a qualidade das rodovías que temos, pois sabemos que na maioria dos casos as rodovias possuem apenas uma faixa. Comparando ano a ano, vemos que com o passar dos anos a quantidade de acidentes em vias de mão simples e dupla diminuem bastante, enquanto as de faixas multiplas se mantém relativamente estáveis (com um pouco de queda). Quando utilizado com outros atributos para formar regras, pode ser que padrões interessantes surgem. Por exemplo, uma possível hipotese que poderia ser provada (ou não) é que nas vias de mão simples os acidentes por ultrapassagem são mais graves do que em mão dupla.
# Contabilizando acidentes por tipo de pista
aux1 <- as.data.frame(table(dados2017$tipo_pista[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux1) <- c("Tipo","Quantidade")
# Reordenando tipo de pista por quantidade de acidentes
aux1$Tipo <- with(aux1, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("a) Tipo da pista dos acidentes (2017)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando acidentes por tipo de pista
aux2 <- as.data.frame(table(dados2018$tipo_pista[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux2) <- c("Tipo","Quantidade")
# Reordenando tipo de pista por quantidade de acidentes
aux2$Tipo <- with(aux2, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("b) Tipo da pista dos acidentes (2018)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando acidentes por tipo de pista
aux3 <- as.data.frame(table(dados2019$tipo_pista[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeando as colunas
colnames(aux3) <- c("Tipo","Quantidade")
# Reordenando tipo de pista por quantidade de acidentes
aux3$Tipo <- with(aux3, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("c) Tipo da pista dos acidentes (2019)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Criando coluna de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando por quantidade de acidentes por tipo
aux$Tipo <- with(aux, reorder(Tipo, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Tipo da pista dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Tipo da pista dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “uso_solo” indica a condição do solo do local de acidente. Uso de solo com valor “Sim” indica que o acidente ocorreu em ambiente rural, e com valor “Não” indica que o acidente ocorreu em ambiente urbano. Os valores sim e não podem se tornar confusos na hora de analisar os resultados, então, por isso, vamos escrever uma pequena função que substitui o valor sim por “Rural” e o valor não por “Urbano”. Comparando ano a ano, vemos que a quantidade de casos gerais diminuem, e no último ano, a quantidade de acidentes urbanos continuam diminuindo. Novamente temos um atributo que por si só não trás muita informação, mas quando for utilizado com outros para formar regras, pode gerar resultados interessantes.
# ENTRADA: Dataframe contendo dados de acidentes do ano
# SAIDA: Dataframe com coluna de uso solo com valores traduzidos para forma mais clara
substituiUsoSolo <- function(dados){
levels(dados$uso_solo) <- c(levels(dados$uso_solo),"Urbano", "Rural")
dados$uso_solo[dados$uso_solo == "Não"] <- "Urbano"
dados$uso_solo[dados$uso_solo == "Sim"] <- "Rural"
dados$uso_solo <- droplevels(dados$uso_solo)
return(dados)
}
dados2017 <- substituiUsoSolo(dados2017)
dados2018 <- substituiUsoSolo(dados2018)
dados2019 <- substituiUsoSolo(dados2019)
dados <- substituiUsoSolo(dados)# Contabiliza identificadores de acidetnes para valores de uso solo
aux1 <- as.data.frame(table(dados2017$uso_solo[!duplicated(dados2017$id)],useNA = "ifany"))
# Renomeia colunas
colnames(aux1) <- c("Solo","Quantidade")
# Reoordena dataframe com base na frequencia de acidentes
aux1$Solo <- with(aux1, reorder(Solo,Quantidade,median))
# Plota o grafico
p1 <- ggplot(aux1, aes(x = Solo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Solo)) +
ggtitle("a) Tipo local dos acidentes (2017)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza identificadores de acidetnes para valores de uso solo
aux2 <- as.data.frame(table(dados2018$uso_solo[!duplicated(dados2018$id)],useNA = "ifany"))
# Renomeia colunas
colnames(aux2) <- c("Solo","Quantidade")
# Reoordena dataframe com base na frequencia de acidentes
aux2$Solo <- with(aux2, reorder(Solo,Quantidade,median))
# Plota o grafico
p1 <- ggplot(aux2, aes(x = Solo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Solo)) +
ggtitle("b) Tipo local dos acidentes (2018)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabiliza identificadores de acidetnes para valores de uso solo
aux3 <- as.data.frame(table(dados2019$uso_solo[!duplicated(dados2019$id)],useNA = "ifany"))
# Renomeia colunas
colnames(aux3) <- c("Solo","Quantidade")
# Reoordena dataframe com base na frequencia de acidentes
aux3$Solo <- with(aux3, reorder(Solo,Quantidade,median))
# Plota o grafico
p1 <- ggplot(aux3, aes(x = Solo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Solo)) +
ggtitle("c) Tipo local dos acidentes (2019)") +
xlab("Tipo") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adiciona coluna de anos
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Cria uniao dos tres dataframes anteriores
aux <- rbind(aux1,aux2,aux3)
# Rerdena com base na quantidade de acidentes
aux$Tipo <- with(aux, reorder(Solo, Quantidade, median))
# Plota o grafico
p1 <- ggplot(aux, aes(fill=Solo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Tipo local dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plota o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Tipo local dos acidentes (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentes") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “idade” contém a idade do indivíduo acidentado. Este atributo é um dos poucos que apresenta muitos valores que podem ser considerados como ruídos, um problema que praticamente não enfrentamos até agora. Para lidar com esse problema, primeiro vamos criar um data frame que contém a distribuição das idades agrupadas durante todos os anos.
Com uma breve análise dos casos extremos, decidimos agrupar todos os anos pois percebemos que as idades se repetem para todos os envolvidos no acidente. Seria no mínimo curioso no acidentes que envolvem pessoas com mais de 100 anos, todos envolvidos terem acima de 100 anos, e na maioria das vezes, a mesma idade. Com essa observação, chegamos à conclusão que na maioria dos casos são informações falsas, que provavelmente foram inseridas por erro humano no registro do acidente, ou apenas para servir como um valor ausente.
# contabilizando as idades
aux <- as.data.frame(table(dados$idade))
# Plotando tabela interativa
DT::datatable(aux[which(aux$Freq > 2),],
rownames = FALSE,
colnames= c('Idade' = 'Var1','Pessoas' = 'Freq'),
filter="top",
options = list(pageLength = 10, scrollX=T))Analisando a tabela acima, podemos identificar 3 grupos distintos de idade. Consideramos o intervalo de 0 até 107 o intervalo que parece ter dados corretos, pois para a maioria dos casos extremos, as pessoas não se encontram no mesmo acidente. A partir de 107, temos que o que começa a ocorrer é que as pessoas com idades “avançadas” começam a aparecer com mais frequência, muitas vezes se repetindo várias vezes no mesmo acidente. Por isso, acreditamos que na maioria desses casos temos ruído. Este intervalo se estende até os valores de 2007.
A partir de 2007 (e até um pouco antes), poderíamos concluir que estes valores são o ano que a pessoa nasceu. Entretanto, analisando alguns casos na base de dados, os acidentes são os mesmos e é improvável que todas pessoas envolvidas em acidente sejam da mesma idade, muito menos, isto ocorrer em quase todos esses acidentes.
Ao analisar as idades de valor de idade zero (imaginávamos que eram com menos de um ano de idade), encontramos algumas irregularidades. Foi identificado que havia indivíduos com menos de um ano de idade que eram condutores. Através de uma consulta buscamos os indivíduos que tinham menos de 18 anos e eram condutores, encontramos 1285 casos para todos os anos. Ao analisar os tipos de veículos desses acidentes, uma parte significativa são bicicletas e a maioria dos acidentados tem mais de 8 anos. Notamos uma concentração anormal de acidentados de 0 anos de idade, sabemos que isso provavelmente são na verdade valores ausentes. Dada esta justificativa, achamos justo classificar estes como valores ausentes na hora de tratar a coluna.
Outra observação válida que podemos fazer é que na maioria dos casos de idade extrema, não conseguimos observar nenhum padrão regional, temporal, ou que envolva qualquer outra variável. Isto nos leva a acreditar que estes valores foram introduzidos aleatoriamente, o que contribui ainda mais para acreditar que seja erro humano. Para a visualização destes dados achamos interessante optar pelo boxplot pois permite identificar valores atípicos de forma gráfica.
Sem realizar nenhuma atividade sobre o atributo idade montamos o seguinte boxplot.
# Criando boxplot a partir da coluna de idades sem preparo da coluna
aux <- ggplot(dados, aes(x = as.factor(lubridate::year(data_inversa)),y = idade, fill = as.factor(lubridate::year(data_inversa)))) +
geom_boxplot() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
ggtitle("Boxplot de Idades (Sem tratar)") +
xlab("Ano") +
ylab("Idade") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(aux)Sabemos que as idades, no estado atual, podem acabar prejudicando nossas regras, então por isso, precisamos fazer algo para lidar com estes dados. Podemos criar uma a função que substitua qualquer valor de idade que esteja fora do nosso padrão de 0 até 107 pelo valor “Não Informado”. Também achamos necessário tratar os casos entre 0 até 3 anos de idade que eram condutores, substituímos estes valores por “Não Informado”, que não é utilizado para elaborar o gráfico.
# ENTRADA: Dataframe contendo dados de acidentes
# SAIDA: Dataframe com acidentes, coluna de idade possui alguns valores tratados
preparaIdade <- function(dados){
dados$idade[which(dados$idade > 107 | dados$idade < 0)] <- NA
dados$idade[which(dados$idade >= 0 & dados$idade <= 3 & dados$tipo_envolvido == "Condutor")] <- NA
return(dados)
}
dados2017 <- preparaIdade(dados2017)
dados2018 <- preparaIdade(dados2018)
dados2019 <- preparaIdade(dados2019)# Atualiza o dataframe contendo os dados de todos os anos
dados <- rbind(dados2017,dados2018,dados2019)
# Criando o boxplot agora com os dados pre processados
aux <- ggplot(dados, aes(x = as.factor(lubridate::year(data_inversa)),y = idade, fill = as.factor(lubridate::year(data_inversa)))) +
geom_boxplot() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
ggtitle("Boxplot de Idades (Após tratar)") +
xlab("Ano") +
ylab("Idade") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(aux)Para regras de associação, achamos que pode ser interessante gerar regras por faixas etárias ao invés de utilizar as idades em si, devido a alta quantidade de valores distintos. Primeiro, temos que criar os grupos de faixa etária e inserir a coluna na base de dados. Abaixo temos uma lista das faixas etárias que criamos e logo depois o código para criar a nova coluna. As faixas etárias criadas são com base em intervalos de 10 anos, onde o primeiro valor é inclusivo e o segundo exclusivo.
# ENTRADA: Dataframe de acidentes
# SAIDA: Dataframe contendo nova coluna de faixa etaria, construida agrupando idade em grupos de 10 anos
converteIdade <- function(dados){
dados$faixa_etaria <- 0
dados$faixa_etaria <- cut(dados$idade,seq(0,2020,by=10), exclude = NULL)
levels(dados$faixa_etaria) <- c(levels(dados$faixa_etaria), "Não Informado")
dados$faixa_etaria[is.na(dados$faixa_etaria)] <- "Não Informado"
dados$faixa_etaria <- droplevels(dados$faixa_etaria)
return(dados)
}
dados2017 <- converteIdade(dados2017)
dados2018 <- converteIdade(dados2018)
dados2019 <- converteIdade(dados2019)# ENTRADA: Dataframe de acidentes
# SAIDA: Dataframe com coluna de idade com NA substituido por Nao Informado
preparaIdade <- function(dados){
dados$idade <- as.factor(dados$idade)
levels(dados$idade) <- c(levels(dados$idade),"Não Informado")
dados$idade[which(is.na(dados$idade))] <- "Não Informado"
return(dados)
}
dados2017 <- preparaIdade(dados2017)
dados2018 <- preparaIdade(dados2018)
dados2019 <- preparaIdade(dados2019)Vemos que as faixas etárias permanecem acontecendo na mesma ordem de quantidade com o passar dos anos, porém as vezes a ordem com que cada faixa etária aparece muda. Algo que já era esperado é que a grande maioria dos acidentados possuem entre 20 a 60 anos. Posteriormente, vemos que isto é porquê a maioria dos casos registrados são para condutores, então, faz sentido a maioria das idades serem a partir da maioridade.
# Contabilizando faixa etaria para 2017
aux1 <- as.data.frame(table(dados2017$faixa_etaria,useNA = "ifany"))
colnames(aux1) <- c("Faixa_Etaria","Quantidade")
aux1$Faixa_Etaria <- with(aux1, reorder(Faixa_Etaria,Quantidade,median))
# Contabilizando faixa etaria para 2018
aux2 <- as.data.frame(table(dados2018$faixa_etaria,useNA = "ifany"))
colnames(aux2) <- c("Faixa_Etaria","Quantidade")
aux2$Faixa_Etaria <- with(aux2, reorder(Faixa_Etaria,Quantidade,median))
# Contabilizando faixa etaria para 2019
aux3 <- as.data.frame(table(dados2019$faixa_etaria,useNA = "ifany"))
colnames(aux3) <- c("Faixa_Etaria","Quantidade")
aux3$Faixa_Etaria <- with(aux3, reorder(Faixa_Etaria,Quantidade,median))
# Adicionando coluna de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando dataframe com uniao dos tres dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando por quantidade de acidentes
aux$Tipo <- with(aux, reorder(Faixa_Etaria, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Faixa_Etaria, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("Faixa etaria dos acidentados (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)As mudanças vistas neste gráfico são praticamente desprezíveis, e no geral, a proporção entre valores de faixa etária permanece relativamente estável com o passar dos anos.
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Faixa_Etaria, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("Faixa etaria dos acidentados (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)O atributo “sexo” nos diz o sexo identificado para a pessoa acidentada. Como há uma pequena quantidade de valores distintos para este atributo, podemos realizar sua visualização através de um data frame. Ao criar este data frame, notamos a existência de um valor chamado de “Ignorado”. Substituímos ele e o valor “NA” por “Não Informado”. Comparando os casos, vemos que há uma queda pequena na quantidade de todos os valores, porém para o valor “Masculino” a queda proporcional é maior.
# ENTRADA: Dataframe de acidentes
# SAIDA: Dataframe de acidentes com valores de sexo ausentes substituitos por Nao Informado
preparaSexo <- function(dados){
levels(dados$sexo) <- c(levels(dados$sexo),"Não Informado")
dados$sexo[which(dados$sexo == "Ignorado" | is.na(dados$sexo))] <- "Não Informado"
dados$sexo <- droplevels(dados$sexo)
return(dados)
}
dados2017 <- preparaSexo(dados2017)
dados2018 <- preparaSexo(dados2018)
dados2019 <- preparaSexo(dados2019)# Contabilizando quantidade de pessoas por sexo
aux1 <- as.data.frame(table(dados2017$sexo, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux1) <- c("Sexo","Quantidade")
# Reordenando pela frequencia do sexo
aux1$Sexo <- with(aux1, reorder(Sexo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Sexo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Sexo)) +
ggtitle("a) Sexo das pessoas acidentadas (2017)") +
xlab("Sexo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando quantidade de pessoas por sexo
aux2 <- as.data.frame(table(dados2018$sexo, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux2) <- c("Sexo","Quantidade")
# Reordenando pela frequencia do sexo
aux2$Sexo <- with(aux2, reorder(Sexo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Sexo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Sexo)) +
ggtitle("b) Sexo das pessoas acidentadas (2018)") +
xlab("Sexo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando quantidade de pessoas por sexo
aux3 <- as.data.frame(table(dados2019$sexo, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux3) <- c("Sexo","Quantidade")
# Reordenando pela frequencia do sexo
aux3$Sexo <- with(aux3, reorder(Sexo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Sexo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Sexo)) +
ggtitle("c) Sexo das pessoas acidentadas (2019)") +
xlab("Sexo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando dataframe contendo a uniao dos anos
aux <- rbind(aux1,aux2,aux3)
# Reordenando pela quantidade de acidentados
aux$Tipo <- with(aux, reorder(Sexo, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Sexo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Sexo das pessoas acidentadas (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Sexo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Sexo das pessoas acidentadas (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Por último, temos o atributo “tipo_envolvido”. Este atributo é responsável por dizer qual tipo de envolvimento a pessoa tinha com o acidente. Primeiro temos que preparar o atributo, já que há existência de valores ausentes. Basta fazer uma simples substituição dos valores ausentes.
# ENTRADA: Dataframe com dados de acidentes
# SAIDA: Dataframe com valores NA de tipo envolvido substituidos por Nao Informado
preparaTipoEnvolvido <- function(dados){
levels(dados$tipo_envolvido) <- c(levels(dados$tipo_envolvido),"Não Informado")
dados$tipo_envolvido[is.na(dados$tipo_envolvido)] <- "Não Informado"
dados$tipo_envolvido <- droplevels(dados$tipo_envolvido)
return(dados)
}
dados2017 <- preparaTipoEnvolvido(dados2017)
dados2018 <- preparaTipoEnvolvido(dados2018)
dados2019 <- preparaTipoEnvolvido(dados2019)Nos gráficos podemos ver grande parte dos envolvidos são condutores, seguido por pedestres e testemunhas em uma quantidade muito menor. Temos uma quantidade insignificante de cavaleiros e não informados, que são casos muito particulares. Para os valores do gráfico de porcentagens, não vemos muitas diferenças.
# Contabilizando acidentados por tipo envolvido
aux1 <- as.data.frame(table(dados2017$tipo_envolvido, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux1) <- c("Tipo","Quantidade")
# Reordenand tipo por quantidade de acidentados
aux1$Tipo <- with(aux1, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux1, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("a) Tipo das pessoas acidentadas (2017)") +
xlab("Tipo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando acidentados por tipo envolvido
aux2 <- as.data.frame(table(dados2018$tipo_envolvido, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux2) <- c("Tipo","Quantidade")
# Reordenand tipo por quantidade de acidentados
aux2$Tipo <- with(aux2, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux2, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("b) Tipo das pessoas acidentadas (2018)") +
xlab("Tipo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Contabilizando acidentados por tipo envolvido
aux3 <- as.data.frame(table(dados2019$tipo_envolvido, useNA = "ifany"))
# Renomeando as colunas do dataframe
colnames(aux3) <- c("Tipo","Quantidade")
# Reordenand tipo por quantidade de acidentados
aux3$Tipo <- with(aux3, reorder(Tipo,Quantidade,median))
# Plotando o grafico
p1 <- ggplot(aux3, aes(x = Tipo, y = Quantidade)) +
geom_bar(stat = "identity", aes(fill = Tipo)) +
ggtitle("c) Tipo das pessoas acidentadas (2019)") +
xlab("Tipo") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Adicionando coluna de ano
aux1$Ano <- 2017
aux2$Ano <- 2018
aux3$Ano <- 2019
# Criando dataframe com a uniao dos dataframes
aux <- rbind(aux1,aux2,aux3)
# Reordenando por quantidade de tipo
aux$Tipo <- with(aux, reorder(Tipo, Quantidade, median))
# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="stack", stat = "identity") +
ggtitle("d) Tipo das pessoas acidentadas (2017 - 2019)") +
xlab("Ano") +
ylab("Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)# Plotando o grafico
p1 <- ggplot(aux, aes(fill=Tipo, y=Quantidade, x=Ano)) +
geom_bar(position="fill", stat = "identity") +
ggtitle("e) Tipo das pessoas acidentadas (2017 - 2019)") +
xlab("Ano") +
ylab("% Acidentados") +
coord_flip() +
viridis::scale_color_viridis(discrete = TRUE, option = "D") +
theme(legend.title = element_blank(),
legend.position = "none")
ggplotly(p1)Nesta seção descrevemos as atividades realizadas para a etapa de mineração de dados. Explicamos as preparações finais realizadas para preparar a base de dados para encontrar regras de associações. Após gerar as regras, utilizamos uma biblioteca de visualização de regras de associação para conseguir interpretar e discutir os resultados encontrados.
Além das atividades já realizadas, há algumas mudanças finais que precisamos realizar para preparar os dados para induzir regras de associação. Primeiro, conforme vimos na análise de integração de dados, precisamos criar uma base única com os dados referentes a todos os anos. Isto foi feito isso no início da análise, mas foi apenas para demonstrar com isso seria feito. Como optamos por realizar as modificações nas bases separadas, precisamos atualizar nossa base completa com todos os dados modificados.
Em segundo lugar, precisamos transformar todas as colunas em valores de tipos categóricos (factor) ou lógicos (boolean), já que é a forma que o pacote arules aceita para realizar a coerção de um data frame para transações segundo a documentação do pacote arules (Michael Hahsler 2020, 92–93). A coerção precisa ser feita pois a implementação do Apriori só consegue usar este tipo de estrutura, e não um data frame em si.
# Transformando todos os dados em fatores para trabalhar com regras de associação
dados$data_dia <- as.factor(dados$data_dia)
dados$data_mes <- as.factor(dados$data_mes)
dados$data_ano <- as.factor(dados$data_ano)Tendo realizado essas atividades, podemos agora utilizar o data frame dados para encontrar regras de associações utilizando a função apriori do pacote arules. É valido comentar sobre o pacote de visualização arulesViz (Michael Hahsler 2019) cuja documentação auxiliou no processo de levantar formas de visualizar as regras de associação geradas. Em relação à interpretação das regras geradas, a seguinte metodologia foi adotada: Após gerar as regras, visualizamos ela utilizando representação de grafos para identificar os principais valores de LHS (left hand side) que definiam o RHS (right hand side) e o uso gráfico de dispersão e análise da saída das métricas para compreender a qualidade das métricas.
Na primeira proposta, tentamos construir regras de associação para entender melhor como os diferentes atributos se relacionam na base de dados para indicar a ocorrência de um sexo ou de outro. A partir de regras que indicam um certo sexo, comparando as regras geradas, podemos identificar certos padrões de valores no registro de acidentes baseados no sexo do indivíduo.
Utilizamos regras de tamanho mínimo 5 e tamanho máximo de 10. Regras deste tamanho tem 4 itens no lado esquerdo e um item no lado direito. Assim, as regras podem ter um valor de suporte relativamente alto (já que não são muito específicas), entretanto, também garante que os resultados não serão genéricos demais. No caso das regras para estado físico com Lesões Leves e Lesões Graves, foi necessário alterar o tamanho máximo para 5 e 6 respectivamente, já que muitas vezes o tempo limite não era atingido durante a geração das regras para o Knitr como era para o Rstudio, logo, várias regras de tamanho maior eram geradas para o Knitr, algo que não acontecia com o RStudio.
Para o retorno das regras, definimos para cada conjunto de regras que apenas as regras que envolvam os valores do atributo “sexo”: “Masculino”; “Feminino” e “Não Informado” no lado direito da regra. Isto nos permite direcionar as regras analisadas, garantindo que elas irão ser referentes ao atributo que desejamos analisar. O data frame abaixo foi criado para apresentar a porcentagem que cada valor desse representa na base de dados.
aux <- as.data.frame(prop.table(table(dados$sexo)))
colnames(aux) <- c("Sexo","Porcentagem")
aux <- aux[order(-aux$Porcentagem),]
DT::datatable(aux,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))A seleção de uma confiança mínima foi feita após identificar que utilizar uma confiança mínima de 1 (ou seja, 100%) gerar resultados muitos específicos, requerendo ajustar o suporte para um valor muito baixo. Achamos melhor trabalhar com um valor mínimo de 0.8 (ou seja, 80%) de confiança.
Algo que influência fortemente a quantidade de regras geradas é o valor de suporte mínimo. Através dele podemos ajustar a quantidade e o escopo das regras geradas. Para encontrar o valor ideal, realizamos um processo iterativo de gerar regras e analisar os resultados através de gráficos. Encontramos que escolher um valor de suporte que gere em torno de 50 regras é o que gera resultados mais interessantes que ainda seja interpretável por meios gráficos.
Sobre a análise das regras geradas, para seleção das regras utilizadas, optamos por ordenar as regras por suporte, e utilizar o lift como um segundo critério de ordenação. É possível fazer o contrário, mas queremos compreender como a “maioria” dos casos se comportam. Para analisar as regras, optamos por utilizar os grafos de regras para visualizar como as diferentes regras se relacionam. Além disto, disponibilizamos diferentes gráficos que permitem conferir as métricas de cada regra e a qualidade das regras geradas. O gráfico que achamos mais interessante é o grafo, que permite visualizar como todas as regras e os valores das regras se relacionam.
Começamos criando uma nova base de dados a partir da existente. Vamos manter todas as instâncias, entretanto, vamos pegar apenas um subconjunto as colunas. Selecionamos atributos que podem ajudar construir perfis de pessoas para identificar possíveis padrões de comportamentos como elevado índice de acidentes em certas datas, regiões ou tipos de veículos.
Optamos por deixar de fora a maioria dos atributos que possuíam muitos valores distintos (mais de 30) pois isto prejudica o tempo que se leva para induzir as regras. Também deixamos de fora identificadores que apesar de serem necessário para encontrar subconjuntos da base de dados, como desejamos utilizar todas as instâncias, não contribuam para as regras. A divisão de estado físico em valores booleanos e classificação do acidente também não foram utilizadas pois já usamos o estado físico.
Para o sexo “Masculino”, geramos um conjunto de 53 regras. O valor de suporte utilizado foi de 0.059. Considerando uma base que teria apenas instâncias do sexo masculino (sexo masculino compõem cerca de 71.3% da base completa) este valor mínimo seria 0.0827, ou seja, as regras valem para no mínimo 8.27% das instâncias masculinas (com sua devida confiança).
Analisando as regras geradas podemos dizer que o perfil levantado parece estar fortemente ligado aos valores que mais se repetem (na base de dados) dentro de cada atributo no lado esquerdo da regra. Notamos uma ocorrência em tipo envolvido sendo “Condutor” no lado esquerdo de todas as regras no grafo. Também notamos que estado físico “Ileso” surge em uma quantidade significativa das regras. Outros valores que se repetem muito são condição meteorológica “Céu Claro”, uso solo “Urbano”, fase do dia “Pleno dia” com tipo pista “Simples” em traçado do tipo “Reta”.
Outro acontecimento interessante que ocorreu é o aparecimento do ano com valor “2017” para um grande quantidade de acidentes. Como já sabemos, neste ano houve uma maior quantidade de acidentes registrados então faz sentido apenas esse valor de ano aparecer. Caso o ano não apareça nos outros sexos, pode ser que isto signifique que a diminuição dos acidentes tenha ocorrido principalmente para o sexo masculino. Há também a ocorrência dos valores “2018” e “2019”, logo, é complicado criar conclusões a partir da presença deste atributo nas regras.
É valido comentar a ocorrência da causa de acidente “Falta de Atenção a Condução” que aparenta ser o principal motivo por acidentes no geral. O tipo de pista “Dupla” também surge. Pelo fato de fase dia como “Plena Noite” ocorrer, acreditamos que a fase do dia não possui tanta importância. A ocorrência de estado físico “Lesões Leves” também é interessante pois ainda assim destaca que estes tipos de acidentes não são tão perigosos. Nota-se o tipo de acidente como sendo “Colisão traseira”, que é interessante pois pode potencialmente explicar o motivo das lesões não serem graves.
rulesMasculino <- arules::apriori(dadosSexo,
parameter=list(minlen = 5 ,maxlen = 10, support=0.059, confidence=0.8, maxtime=100),
appearance = list(rhs = c("sexo=Masculino"),default="lhs"),
control = list(verbose=F))
rulesMasculino <- subset(rulesMasculino, subset= lift > 1.2)
rulesMasculino <- arules::sort(rulesMasculino,by=c("support","lift"),decreasing=TRUE)
rulesMasculino <- head(rulesMasculino, n = 100)
summary(rulesMasculino)## set of 53 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 45 8
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.151 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.05915 Min. :0.8563 Min. :1.200 Min. :31437
## 1st Qu.:0.06265 1st Qu.:0.8645 1st Qu.:1.212 1st Qu.:33298
## Median :0.07290 Median :0.8725 Median :1.223 Median :38742
## Mean :0.07964 Mean :0.8770 Mean :1.229 Mean :42326
## 3rd Qu.:0.09389 3rd Qu.:0.8906 3rd Qu.:1.248 3rd Qu.:49902
## Max. :0.12226 Max. :0.9128 Max. :1.279 Max. :64980
##
## mining info:
## data ntransactions support confidence
## dadosSexo 531470 0.059 0.8
Seguindo com análise, identificamos 55 regras para o sexo “Feminino”. O valor de suporte mínimo precisou ser ajustado para 0.00021, que é extraordinariamente baixo, mesmo com uma quantidade baixa de instâncias com sexo feminino. Temos que este valor de suporte em uma base com apenas instâncias do sexo feminino (sexo feminino compõem cerca de 22.3% da base completa) seria 0.000942, ou seja, as regras valem para no mínimo 0.0942% das instâncias (com sua devida confiança). Este valor baixo deve refletir na forma que as regras obtidas são interpretadas. Podemos dizer que essas regras tratam uma quantidade de casos muito específicos, e não são casos gerais como queremos.
Uma característica que notamos que se repete muito é que o tipo envolvido é “Passageiro” para todas as regras. Em seguida, notamos que o estado físico “Lesões Leves” também aparece em uma quantidade elevada de regras. Dois valores para faixa etaria que destacam muito são “(50,60]” e “(40,50]”, seguido por uma quantidade menor de “(60,70]”. Isto é interessante pois as idades podem ser consideradas mais avançadas, e seria interessante descobrir o motivo disto acontecer. Outros valores que aparecem com frequência mais baixa são: UF sendo “SC”; tipo veículo sendo “Automóvel”; Dia da semana sendo “Domingo” e uso solo sendo “Rural”. Novamente, destacamos que estas regras aparentam cubrir uma quantidade muito pequena de casos, e provavelmente são altamente específicas.
Nota-se que a principal causa de acidente é “Não Guardar distância de segurança”. O tipo de veículo “Motocicleta” e “Motoneta” aparecem entre as regras, e é interessante pois é alco que não foi observado para aqueles do sexo masculino. Estes acidentes aparentemente ocorrem em conjunto com o tipo de acidente “Tombamento” e fase dia “Pleno Dia”. Outros valore que ssurge para tipo de acidente é “Engavetamento” que é um valor pouco comum na base de dados.
A faixa etaria de “(30,40]” e “(20,30]” também surge entre o conjunto de regras, logo não da para gerar conclusões a partir da faixa etaria. A data de ano “2019” aparenta se destacar, pois aparece com em o dobro de regras que “2017” aparece para este conjunto. O traçado a via surge como “Intersecção de Vias”, sendo algo interessante, já que é um falor incomum.
rulesFeminino <- arules::apriori(dadosSexo,
parameter=list(minlen = 5 ,maxlen = 10, support=0.00021, confidence=0.8, maxtime=100),
appearance = list(rhs = c("sexo=Feminino"),default="lhs"),
control = list(verbose=F))
rulesFeminino <- subset(rulesFeminino, subset= lift > 1.2)
rulesFeminino <- arules::sort(rulesFeminino,by=c("support","lift"),decreasing=TRUE)
rulesFeminino <- head(rulesFeminino, n = 100)
summary(rulesFeminino)## set of 55 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 3 52
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 6.000 6.000 5.945 6.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.0002107 Min. :0.8000 Min. :3.590 Min. :112.0
## 1st Qu.:0.0002230 1st Qu.:0.8045 1st Qu.:3.610 1st Qu.:118.5
## Median :0.0002540 Median :0.8116 Median :3.642 Median :135.0
## Mean :0.0002736 Mean :0.8136 Mean :3.651 Mean :145.4
## 3rd Qu.:0.0003001 3rd Qu.:0.8223 3rd Qu.:3.690 3rd Qu.:159.5
## Max. :0.0006360 Max. :0.8394 Max. :3.767 Max. :338.0
##
## mining info:
## data ntransactions support confidence
## dadosSexo 531470 0.00021 0.8
Para o valor “Não Informado” conseguimos gerar 51 regras utilizando um suporte mínimo de 0.0115. Para uma base com apenas os casos de em que o sexo não foi informado (sexo não informado compõem cerca de 6.4% da base completa), este valor seria por volta de 0.180, ou seja, as regras valem para no mínimo 18.75% das instâncias (com sua devida confiança). Com isso, temos que para este valor do atributo, conseguimos gerar regras mais gerais mantendo um valor de confiança bem maior do que as outras regras.
Algo que percebemos é que os valores estado físico “Não Informado” e faixa etária “Não Informada” aparecem para quase todas as regras. Isto nos permite a sugerir que os valores não informados para sexo ocorrem de forma sistêmica e não aleatória.
Outros valores que aparecem de forma repetida para diferentes regras são: Traçado da via “Reta”; Tipo envolvido “Condutor”; Condição Meteorológica “Céu Claro” e Tipo de Pista “Simples”. Notamos que o uso solo que prevalece é “Rural”, fase dia “Plena Noite” e também foi observado uma auta incidência com tipo veículo “Automóvel”.
Valores observados que repetem em pouca quantidade são: Uso de solo “Urbano”; Fase do dia “Plena Noite”, o que indica que o atributo fase dia não é muito importante; Causa de acidente como sendo “Falta de Atenção a Condução”; Tipo envolvido “Testemunha” - isto pode explicar porque os valores não são informados; Tipo de pista “Dupla” e ano “2017”.
Um fator que achamos que poderia influenciar o valor de sexo não informado seria o valor do estado físico, onde haveria acidentes que seriam impossível realizar o reconhecimento do sexo devido a gravidade. Como valores mais extremos de estado físico não apareceram nas regras geradas, acreditamos que caso este tipo de acontecimento ocorra, é em uma quantidade baixa de casos e que a maioria dos dados ausentes seja causada pela ausência de outros dados.
rulesSexNA <- arules::apriori(dadosSexo,
parameter=list(minlen = 5 ,maxlen = 10, support=0.0115, confidence=0.8, maxtime=100),
appearance = list(rhs = c("sexo=Não Informado"),default="lhs"),
control = list(verbose=F))
rulesSexNA <- subset(rulesSexNA, subset= lift > 1.2)
rulesSexNA <- arules::sort(rulesSexNA,by=c("support","lift"),decreasing=TRUE)
rulesSexNA <- head(rulesSexNA, n = 100)
summary(rulesSexNA)## set of 51 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 49 2
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.039 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.01151 Min. :0.8052 Min. :12.65 Min. : 6117
## 1st Qu.:0.01223 1st Qu.:1.0000 1st Qu.:15.72 1st Qu.: 6500
## Median :0.01324 Median :1.0000 Median :15.72 Median : 7039
## Mean :0.01432 Mean :0.9865 Mean :15.50 Mean : 7612
## 3rd Qu.:0.01595 3rd Qu.:1.0000 3rd Qu.:15.72 3rd Qu.: 8478
## Max. :0.02174 Max. :1.0000 Max. :15.72 Max. :11554
##
## mining info:
## data ntransactions support confidence
## dadosSexo 531470 0.0115 0.8
Nesta proposta procuramos entender quais fatores influenciam o resultado do estado físico de um acidentado. Podemos gerar um conjunto de regras de associações para cada valor de estado físico que podemos ter na base de dados. Seguindo o padrão, podemos comparar as regras e métricas obtidas através dessa análise para tentar gerar um conhecimento.
Os padrões de: tamanho mínimo e máximo de regra; confiança mínima; metodologia de criação e seleção de regras foram todos mantidos conforme nas análises de perfil por sexo, pelos mesmos motivos explicados. Para alguns valores não foi possível manter o padrão de gerar por volta de 50 regras devido a dificuldade encontrada para gerar regras.
Para o retorno da regra utilizamos a regras que possuem no lado direito apenas os valores do atributo estado_físico: “Ileso”; “Lesões Leves”; “Lesões Graves”; “Óbito” e “Não Informado”. O data frame abaixo foi criado para apresentar a porcentagem que cada valor desse representa na base de dados.
aux <- as.data.frame(prop.table(table(dados$estado_fisico)))
colnames(aux) <- c("Estado_Fisico","Porcentagem")
aux <- aux[order(-aux$Porcentagem),]
DT::datatable(aux,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))Os atributos foram selecionados da mesma forma que selecionamos nos casos anteriores. Escolhemos os atributos que acreditamos que poderia gerar relações interessantes que possam ser interpretadas analisando o contexto dos acidentes. Atributos que possuem muitos valores distintos não foram utilizados.
Para as pessoas com estado físico ileso, foram geradas 46 regras. Utilizamos o valor 0.02 para o suporte mínimo. Considerando uma base que teria apenas instâncias com estado físico ileso (compõem cerca de 46.3% da base completa) este valor mínimo seria 0.0432, ou seja, as regras valem para no mínimo 4.32% das instâncias com estado físico ileso.
Analisando o grafo, podemos notar que quase todas as regras possuem tipo envolvido “Condutor” e o tipo de veículo é “Automóvel”. Vemos também que em muitos casos o solo é “Rural”, o sexo é “Masculino” e o traçado da via é “Reta”.
Algo interessante que vemos é o tipo de acidente geralmente é “Colisão Traseira”. Isto é interessante pois intuitivamente, esperamos que uma colisão traseira seja menos perigosa do que outros tipos de colisões (frontal, lateral, etc.). Vemos também que o tipo do veículo as vezes surge como “Caminhão-trator” e “Caminhão”. Estes dois valores, em conjunto com a ausência de valores como “Motocicletas” e “Motonetas” nas regras são interessantes, pois sugere que estes veículos maiores geralmente são mais “protegidos” no acidente.
Outros valores que surgem ocasionalmente nas regras são Ano 2017, fase do dia como “Pleno Dia”, condição meteorológica como “Céu Claro”, tipo de pista “Dupla” e faixa etária como “(30,40]”.
rulesEFIleso <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.02, confidence=0.8, maxtime=100),
appearance = list(rhs = c("estado_fisico=Ileso"),default="lhs"),
control = list(verbose=F))
rulesEFIleso <- subset(rulesEFIleso, subset= lift > 1.2)
rulesEFIleso <- arules::sort(rulesEFIleso,by=c("support","lift"),decreasing=TRUE)
rulesEFIleso <- head(rulesEFIleso, n = 100)
summary(rulesEFIleso)## set of 46 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6 7
## 12 21 13
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.250 6.000 6.022 7.000 7.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.02037 Min. :0.8001 Min. :1.730 Min. :10827
## 1st Qu.:0.02266 1st Qu.:0.8078 1st Qu.:1.746 1st Qu.:12046
## Median :0.02565 Median :0.8157 Median :1.764 Median :13634
## Mean :0.02835 Mean :0.8212 Mean :1.776 Mean :15066
## 3rd Qu.:0.03182 3rd Qu.:0.8334 3rd Qu.:1.802 3rd Qu.:16911
## Max. :0.05646 Max. :0.8616 Max. :1.863 Max. :30007
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.02 0.8
Geramos 52 regras para as pessoas com estado físico como “Lesões Leves”. O valor de suporte utilizado foi 0.00145. Considerando uma base que teria apenas instâncias com estado físico lesões leves (compõem cerca de 34.8% da base completa) este valor mínimo seria 0.00417, ou seja, as regras valem para no mínimo 0.417% das instâncias com estado físico lesões leves.
Através da análise do grafo construindo com as regras, podemos ver que o tipo de veículo “Motocicleta” está presente na maioria das regras. Como já é comum, o traçado via aparece como “Reta”. Outro valor que aparece em muitas dessas regras é o tipo de acidente “Tombamento”.
Notamos também a existência de “grupos” de regras que possuem certas características. Para as regras associadas ao sexo “Masculino” notamos que os valores de tipo envolvido “Condutor” e município “GUARULHOS” aparecem em uma parte significante dessas regras. O valor de BR “116” e UF “SP” surge em uma quantidade interessante nessas regras.
Outro grupo que aparece são as regras associadas ao sexo “Feminino”. Uma quantidade interessante dessas regras são ligadas ao tipo envolvido “Passageiro” e tipo acidente “Queda de ocupante do veículo”, que é um tipo de acidente raro.
Algo interessante que surgiu foi a causa do acidente “Defeito Mecânico no Veículo”, que acontece para uma quantidade baixa de pessoas na base de dados, mas por ela surgir neste conjunto de regras, acreditamos que ela seja um forte indicador de estado físico como com “Lesões Leves”.
Outros valores que aparecem de forma mais aleatória na base de dados são: Faixa etária “(20,30]”; tipo de acidente “Colisão Lateral”; uso de solo “Rural”; fase do dia “Pleno Dia” e tipo de veículo "Motoneta". Não citamos os valores que apareceram para uma única regra.
Foi necessário modificar o maxlen de 10 para 6 para manter os resultados gerados para o Knitr consistentes com aqueles gerados no RStudio.
rulesEFLeve <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 6, support=0.00145, confidence=0.8, maxtime=100),
appearance = list(rhs = c("estado_fisico=Lesões Leves"),default="lhs"),
control = list(verbose=F))
rulesEFLeve <- subset(rulesEFLeve, subset= lift > 1.2)
rulesEFLeve <- arules::sort(rulesEFLeve,by=c("support","lift"),decreasing=TRUE)
rulesEFLeve <- head(rulesEFLeve, n = 100)
summary(rulesEFLeve)## set of 52 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 30 22
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.423 6.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.001453 Min. :0.8002 Min. :2.298 Min. : 772.0
## 1st Qu.:0.001525 1st Qu.:0.8046 1st Qu.:2.311 1st Qu.: 810.8
## Median :0.001639 Median :0.8080 Median :2.321 Median : 871.0
## Mean :0.001688 Mean :0.8114 Mean :2.330 Mean : 897.2
## 3rd Qu.:0.001795 3rd Qu.:0.8151 3rd Qu.:2.341 3rd Qu.: 954.0
## Max. :0.002395 Max. :0.8469 Max. :2.433 Max. :1273.0
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.00145 0.8
No casos com “Lesões Graves”, conseguimos identificar 42 regras, que é mais baixo do que o normalmemente adotado. O valor de suporte utilizado foi 0.000036. Considerando uma base que teria apenas instâncias com estado físico lesões graves (compõem cerca de 10.3% da base completa) este valor mínimo seria 0.000350, ou seja, as regras valem para no mínimo 0.0350% das instâncias com estado físico lesões graves.
Nessas regras encontramos uma separação óbvia entre dois grupos de regras. Devido ao suporte tão baixo, acreditamos que essa separação seja um ou dois registros de acidentes que envolveram uma grande quantidade de pessoas, já que o suporte é tão baixo. Para o primeiro grupo, vemos que os valores: município “PARAISO DE TOCANTINS”; com data semana “(7,14]”; No trecho KM “(510,520]” e na BR “153”. Vemos também que o traçado da via geralmente é “Reta” e o tipo de pista é “Simples”.
Para o segundo grupo vemos a repetição dos valores: Tipo veículo “Ônibus”; Município “TORRES” e sexo “Feminino”. Dentro deste grupo vemos a ocorrência de vários valores para completar o terceiro item da regra, que geralmente só aparecem em uma regra.
Algo interessante que ocorre é que os valores de fase de dia “Plena noite”; Causa de acidente como “Condutor dormindo” e ano “2018” no primeiro dia do mês se repetem algumas vezes. O que é interessante é que esses valores são mais raros, e mesmo assim surgem na regra. Isto pode indicar que acidentes a noite geralmente tem uma elevada chance de ser causados por um condutor dormindo, entretanto, temos que levar em conta que o suporte para estas regras é muito baixo. Notamos também a existência de valores como tipo veículo “Motocicleta”. Isto nos leva a observar a ausência do tipo veículo “Automóvel”. Isto pode possivelmente indicar que acidentes de automóveis sejam menos perigosos.
Foi necessário modificar o maxlen de 10 para 5 para manter os resultados gerados para o Knitr consistentes com aqueles gerados no RStudio.
rulesEFGrave <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 5, support=0.000036, confidence=0.8, maxtime=100),
appearance = list(rhs = c("estado_fisico=Lesões Graves"),default="lhs"),
control = list(verbose=F))
rulesEFGrave <- subset(rulesEFGrave, subset= lift > 1.2)
rulesEFGrave <- arules::sort(rulesEFGrave,by=c("support","lift"),decreasing=TRUE)
rulesEFGrave <- head(rulesEFGrave, n = 100)
summary(rulesEFGrave)## set of 42 rules
##
## rule length distribution (lhs + rhs):sizes
## 5
## 42
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 5 5 5 5 5
##
## summary of quality measures:
## support confidence lift count
## Min. :3.763e-05 Min. :0.8000 Min. :7.731 Min. :20.00
## 1st Qu.:3.763e-05 1st Qu.:0.8000 1st Qu.:7.731 1st Qu.:20.00
## Median :3.763e-05 Median :0.8333 Median :8.053 Median :20.00
## Mean :3.884e-05 Mean :0.8387 Mean :8.105 Mean :20.64
## 3rd Qu.:3.763e-05 3rd Qu.:0.8472 3rd Qu.:8.188 3rd Qu.:20.00
## Max. :4.892e-05 Max. :0.9231 Max. :8.921 Max. :26.00
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 3.6e-05 0.8
Conseguimos gerar um conjunto de 50 regras para os casos de estado físico com “Óbito”. O suporte utilizado foi 0.00002. Considerando uma base que teria apenas instâncias com estado físico com Óbitos (compõem cerca de 3.2% da base completa) este valor mínimo seria 0.000625, ou seja, as regras valem para no mínimo 0.0625% das instâncias com estado físico “Óbito”.
Sobre as regras encontradas, enxergamos um padrão que estes casos são na sua maioria para pedestres. Valores como tipo envolvido “Pedestre”, Causa de acidente “Desobediência às normas de trânsito (pedestre)” e tipo acidente “Atropelamento de Pedestre” se repetem para várias regras. Algo interessante é que o tipo veículo “Outros” aparece para a maioria dos casos. Isto nos leva a acreditar que este valor é usado nos casos de pedestres, que estavam sem veículos.
Algo interessante que vimos é a presença da faixa etária “(40,50]” e “(80,90]” para 3 regras diferentes cada, e o valor “(60,70]” para uma regra. Pode ser que uma idade elevada esteja associada a um maior risco físico para um acidentado, mas relembramos que os valores de suporte são muito baixos.
Vemos que o tipo veículo “Caminhão” também aparece para duas regras. Isto vai contra a intuição que tínhamos até então, que veículos de grande porte por serem mais “protegidos” geralmente produzem estados físicos mais leves. Notamos em um subgrupo de regras que o valor Uso Solo “Urbano”, fase do dia “Plena Noite”, e causa de acidente como sendo “Restrição de Visibilidade” ocorre em conjunto. Analisando os casos que possuem esta característica, talvez seria possível identificar trechos pouco iluminados que são foco de acidentes.
Outros valores referentes a regiões se repetem como UF “GO” e BR “316”. Algo peculiar que notamos é que a fase do dia “Amanhecer” aparece em algumas regras e também o dia da semana “Domingo”. Notamos a ocorrência de sexo “Não Informado” em uma regra. Mais uma vez, como dito na análise das regras geradas com o atributo de sexo, isto vai contra a linha de raciocínio inicialmente estabelecida. Achamos que os valores “Não Informados” iriam aparecer mais para casos de óbito, mas isto não foi observado de forma evidente nas regras. Os outros valores não citados ocorrem somente em uma regra.
rulesEFObito <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.00002, confidence=0.8, maxtime=100 ),
appearance = list(rhs = c("estado_fisico=Óbito"),default="lhs"),
control = list(verbose=F))
rulesEFObito <- subset(rulesEFObito, subset= lift > 1.2)
rulesEFObito <- arules::sort(rulesEFObito,by=c("support","lift"),decreasing=TRUE)
rulesEFObito <- head(rulesEFObito, n = 50)
summary(rulesEFObito)## set of 50 rules
##
## rule length distribution (lhs + rhs):sizes
## 5
## 50
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 5 5 5 5 5
##
## summary of quality measures:
## support confidence lift count
## Min. :2.258e-05 Min. :0.8000 Min. :25.23 Min. :12.00
## 1st Qu.:2.634e-05 1st Qu.:0.8125 1st Qu.:25.63 1st Qu.:14.00
## Median :3.011e-05 Median :0.8297 Median :26.17 Median :16.00
## Mean :3.210e-05 Mean :0.8407 Mean :26.52 Mean :17.06
## 3rd Qu.:3.763e-05 3rd Qu.:0.8659 3rd Qu.:27.31 3rd Qu.:20.00
## Max. :5.080e-05 Max. :1.0000 Max. :31.54 Max. :27.00
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 2e-05 0.8
Para os casos com estado físico “Não Informado” foram geradas 46 regras. O suporte utilizado foi 0.011. Considerando uma base que teria apenas instâncias com estado físico com Óbitos (compõem cerca de 5.4% da base completa) este valor minímo seria 0.204, ou seja, as regras valem para no mínimo 20.4% das instâncias com estado físico Não Informado.
O mesmo padrão que vimos para a análise das regras com valor de sexo “Não Informado”, vemos aqui. Para as regras de estado físico “Não Informado”, vemos a repetição de regras com sexo e faixa etaria “Não Informado”. Vemos a repetição de alguns outros valores comuns na base de dados como tipo pista “Simples” e “Dupla”, fase do dia “Pleno dia” e “Plena noite” traçado via “Reta”, condição meteriológica “Céu Claro”.
Outros valores que notamos que ocorre em conjunto em regras são tipo veículo “Automóvel” e tipo envolvido “Condutor”. Notamos que os casos em que o tipo envolvido é “Testemunha” temos um lift bem mais alto que do que os outros casos. Ambos os valores de uso solo (“Urbano” e “Rural”) aparecem nas regras criadas. Notamos também que a única causa que aparece é “Falta de atenção à Condução”.
rulesEFna <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.011, confidence=0.8, maxtime=100),
appearance = list(rhs = c("estado_fisico=Não Informado"),default="lhs"),
control = list(verbose=F))
rulesEFna <- subset(rulesEFna, subset= lift > 1.2)
rulesEFna <- arules::sort(rulesEFna,by=c("support","lift"),decreasing=TRUE)
rulesEFna <- head(rulesEFna, n = 100)
summary(rulesEFna)## set of 46 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 42 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.087 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.01102 Min. :0.8007 Min. :14.79 Min. : 5856
## 1st Qu.:0.01159 1st Qu.:0.8392 1st Qu.:15.50 1st Qu.: 6159
## Median :0.01269 Median :0.8483 Median :15.67 Median : 6744
## Mean :0.01384 Mean :0.8524 Mean :15.75 Mean : 7358
## 3rd Qu.:0.01585 3rd Qu.:0.8606 3rd Qu.:15.90 3rd Qu.: 8424
## Max. :0.02174 Max. :0.9998 Max. :18.47 Max. :11554
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.011 0.8
Na nossa terceira proposta para aplicação de regras de associação buscamos compreender perfil de cada tipo de envolvido em um acidente. Com esta análise, é possível compreender como o papel que uma pessoa tem em um acidente é influenciado por outros fatores. A partir do atributo tipo envolvido, geramos, analisamos e comparamos as regras para os valores possíveis de tipo de envolvido em acidente.
As configurações para gerar as regras são as mesmas, mantendo o tamanho mínimo de 5 e máximo de 10. Fizemos isso para seguir o padrão adotado no estudo dos outros atributos, além dos motivos previamente explicados.
Para o retorno das regras definimos quatro valores diferentes, uma para cada conjunto de regras geradas. Desta forma, foram retornadas nos resultados apenas as regras com os valores: “Condutor”; “Passageiro”; “Pedestre” e “Testemunha”. Não conseguimos gerar regras para os outros valores por motivos que serão explicados. O data frame abaixo foi criado para apresentar a porcentagem que cada valor desse representa na base de dados.
aux <- as.data.frame(prop.table(table(dados$tipo_envolvido)))
colnames(aux) <- c("Tipo_Envolvido","Porcentagem")
aux <- aux[order(-aux$Porcentagem),]
DT::datatable(aux,
rownames = FALSE,
filter="top",
options = list(pageLength = 10, scrollX=T))O valor de confiança mínima foi mantido em 0.8 conforme descrito anteriormente nas outras análises. O valor de suporte foi ajustado para gerar por volta de 50 regras por valor. O lift foi usado como critério de desempate na ordenação por suporte.
A seleção de colunas foi praticamente idêntica a feita anteriormente. Escolhemos atributos que acreditamos ser bons candidatos para descrever o perfil de um tipo de envolvido em acidente, além de limitar o nosso escopo para atributos que tinha menos de cerca de 30 níveis distintos. A nova base de dados mantém todas as linhas, porém mantendo apenas um subconjunto das colunas.
Para este conjunto de regras, conseguimos ajustar o valor de suporte para gerar 54 regras. O valor de suporte utilizado foi 0.07. Considerando uma base que teria apenas instâncias do tipo envolvido condutor (condutor compõem cerca de 69.8% da base completa) este valor mínimo seria 0.10, ou seja, as regras valem para no mínimo 10.0% das instâncias de condutor (com sua devida confiança).
Analisando as regras através do grafo, vemos que o principal padrão da base de dados se repete. Os valores que mais aparecem nas regras são: Sexo “Masculino”; Condição Meteorológica “Céu Claro” e fase dia “Pleno dia”; Estado físico “Ileso” e traçado de via “Reta”.
Outros valores que notamos que se repetem com menos intensidade são: Ambos valores de uso solo “Rural” e “Urbano”; Tipo pista “Dupla” e “Simples”; Causa de acidente “Falta de atenção a condução”; Tipo de veículo “Automóvel” e data ano “2017”. O valor tipo acidente “Colisão traseira” apareceu em uma única regra.
rulesTECondutor <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.07, confidence=0.8, maxtime=100),
appearance = list(rhs = c("tipo_envolvido=Condutor"),default="lhs"),
control = list(verbose=F))
rulesTECondutor <- subset(rulesTECondutor, subset= lift > 1.2)
rulesTECondutor <- arules::sort(rulesTECondutor,by=c("support","lift"),decreasing=TRUE)
rulesTECondutor <- head(rulesTECondutor, n = 100)
summary(rulesTECondutor)## set of 54 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 53 1
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.019 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.07016 Min. :0.8381 Min. :1.200 Min. :37286
## 1st Qu.:0.07501 1st Qu.:0.8623 1st Qu.:1.235 1st Qu.:39866
## Median :0.08584 Median :0.8838 Median :1.266 Median :45619
## Mean :0.08716 Mean :0.8823 Mean :1.264 Mean :46321
## 3rd Qu.:0.09533 3rd Qu.:0.8980 3rd Qu.:1.286 3rd Qu.:50663
## Max. :0.12226 Max. :0.9351 Max. :1.339 Max. :64980
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.07 0.8
Para as regras de Passageiro, geramos um conjunto de 51 regras distintas. O valor de suporte mínimo utilizado foi 0.007. Considerando uma base de dados somente com passageiros (compõem 26.0% da base original), o valor de suporte mínimo seria 0.2690, ou seja, essas regras valeriam para no mínimo 26.9% das instâncias, com sua devida confiança.
Analisando o grafo vemos que os valores: Sexo “Feminino”; Tipo de pista “Simples”; Estado físico com “Lesões Leves”; Uso solo “Urbano” e tipo veículo “Automóvel” são muito recorrentes nas regras. Outros valores que aparecem em um quantidade menor mas mesmo assim significante são: Dia da semana “Domingo”; Condição meteorológica “Céu Claro” e fase “Pleno Dia” e “Plena Noite”; Tipo acidente “Colisão Frontal”; Faixa etária de “(10,20]”; Traçado de via “Reta” se repetem com bastante frequência. Achamos interessante comentar que o perfil para estas regras ficou extremamente claro, e não é o tradicional que vemos na nossa base de dados. Outro destaque é que diferente da maioria das regras geradas até agora, o uso solo “Rural” não aparece nas regras o que fortemente associa esse perfil ao ambiente urbano.
Alguns valores que aparecem com relativamente baixa frequência são: “Condição meteorológica Chuva”; Causa acidente “Velocidade Incompatível”; UF “MG”; e Estado físico como “Lesões Graves”. Os outros valores não citados ocorrem em apenas uma regra.
rulesTEPassageiro <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.007, confidence=0.8, maxtime=100),
appearance = list(rhs = c("tipo_envolvido=Passageiro"),default="lhs"),
control = list(verbose=F))
rulesTEPassageiro <- subset(rulesTEPassageiro, subset= lift > 1.2)
rulesTEPassageiro <- arules::sort(rulesTEPassageiro,by=c("support","lift"),decreasing=TRUE)
rulesTEPassageiro <- head(rulesTEPassageiro, n = 100)
summary(rulesTEPassageiro)## set of 51 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 39 12
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.235 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.007001 Min. :0.8012 Min. :3.078 Min. : 3721
## 1st Qu.:0.007587 1st Qu.:0.8052 1st Qu.:3.093 1st Qu.: 4032
## Median :0.008386 Median :0.8144 Median :3.129 Median : 4457
## Mean :0.009304 Mean :0.8361 Mean :3.212 Mean : 4945
## 3rd Qu.:0.010158 3rd Qu.:0.8402 3rd Qu.:3.228 3rd Qu.: 5398
## Max. :0.020490 Max. :0.9952 Max. :3.823 Max. :10890
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.007 0.8
Para este conjunto de regras foram gerados 49 regras. O suporte mínimo utilizado foi extremamente menor que os outros, sendo 0.0021. Considerando uma base de dados somente com pedestres (compõem 2.2% da base original), o valor de suporte mínimo seria 0.0955, ou seja, essas regras valeriam para no mínimo 9.55% das instâncias, com sua devida confiança.
Para as regras geradas, encontramos que os valores mais comuns no grafo são: Tipo acidente “Atropelamento de Pedestre”; Estado físico como “Lesões graves”; Sexo como “Masculino”; Traçado via “Reta” e causa de acidente sendo “Falta de Atenção de Pedestre”. Isto nos mostra um perfil que quando um pedestre é envolvido em acidente, é provável que ele seja culpado além de sair com sérios ferimentos. Quando paramos para analisar e comparar com outros tipos, isto faz sentido, já que não há outra forma de um pedestre estar envolvido sem ser atingido, e ele não possui nenhum veículo para lhe proteger.
Notamos que há também uma quantidade muito significante de regras com estado físico com “Óbito”. Algo surpreendente que ocorreu é que uma parte significante das regras ligadas a óbito também possui fase dia como “Plena Noite”. Isto pode indicar que para um pedestre, o horário do acidente/fase do dia pode ser um agravante em seu estado físico. O valor do lift alto dessas regras também é interessante. Em apenas uma regra do conjunto aparece o valor de fase do dia “Pleno dia”, o que reforça mais ainda essa idéia. Notamos que o uso solo “Rural” aparece em uma quantidade muito maior de regras do que o “Urbano”, que aparece somente em uma.
Outra curiosidade que notamos é que há quatro regras ligadas ao valor de tipo veículo “Automóvel”. O valor estado físico “Lesões Leves” aparece em 2 regras, que ambas possuem valor tipo veículo “Automóvel”. Isto nos leva a acreditar que esses acidentes mais graves seja causado por outros tipos de veículos que não sejam automóveis. Os valores de tipo pista “Simples” e “Dupla” aparecem em quantidade semelhante de regras.
rulesTEPedestre <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.0021, confidence=0.8, maxtime=100),
appearance = list(rhs = c("tipo_envolvido=Pedestre"),default="lhs"),
control = list(verbose=F))
rulesTEPedestre <- subset(rulesTEPedestre, subset= lift > 1.2)
rulesTEPedestre <- arules::sort(rulesTEPedestre,by=c("support","lift"),decreasing=TRUE)
rulesTEPedestre <- head(rulesTEPedestre, n = 100)
summary(rulesTEPedestre)## set of 49 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 39 10
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 5.000 5.204 5.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.002113 Min. :0.8222 Min. :38.19 Min. :1123
## 1st Qu.:0.002288 1st Qu.:0.8404 1st Qu.:39.04 1st Qu.:1216
## Median :0.002439 Median :0.8623 Median :40.05 Median :1296
## Mean :0.002636 Mean :0.8867 Mean :41.19 Mean :1401
## 3rd Qu.:0.002894 3rd Qu.:0.9529 3rd Qu.:44.26 3rd Qu.:1538
## Max. :0.004237 Max. :0.9727 Max. :45.18 Max. :2252
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.0021 0.8
Para os casos de testemunhas geramos um conjunto de 52 regras. O suporte mínimo utilizado foi 0.00022. Considerando uma base de dados somente com testemunhas (compõem 1.97% da base original), o valor de suporte mínimo seria 0.0112, ou seja, essas regras valeriam para no mínimo 1.1% das instâncias, com sua devida confiança.
Vemos que os valores não informados predominam para testemunhas. Observamos no grafo que os valores mais centralizados são: Estado físico “Não Informado”; Sexo “Não Informado” e faixa etária “Não Informado”. Notamos também que os valores usam solo “Urbano”; UF “MG”; fase do dia “Pleno Dia” e tipo veículo “Motocicleta” aparecem bastante, e os acidentes de motocicleta estão todos ligados ao ano de “2017”. Isto pode indicar que esta política de não obter informações de testemunhas seja ligada a alguma região do estado ou algo do gênero.
O valor de tipo acidente como “Colisão frontal” parece estar fortemente associado ao valor de tipo veículo “Caminhão trator” que é uma combinação no mínimo peculiar. Notamos que o tipo de pista “Simples” acontece em quantidade grande também e parece estar relacionado a condição meteorológica “Sol”. O valor de UF “RS” também aparece em quatro regras diferentes.
rulesTETestemunha <- arules::apriori(dadosEstadoFis,
parameter=list(minlen = 5 ,maxlen = 10, support=0.00022, confidence=0.8, maxtime=100),
appearance = list(rhs = c("tipo_envolvido=Testemunha"),default="lhs"),
control = list(verbose=F))
rulesTETestemunha <- subset(rulesTETestemunha, subset= lift > 1.2)
rulesTETestemunha <- arules::sort(rulesTETestemunha,by=c("support","lift"),decreasing=TRUE)
rulesTETestemunha <- head(rulesTETestemunha, n = 100)
summary(rulesTETestemunha)## set of 52 rules
##
## rule length distribution (lhs + rhs):sizes
## 5 6
## 16 36
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.000 5.000 6.000 5.692 6.000 6.000
##
## summary of quality measures:
## support confidence lift count
## Min. :0.0002201 Min. :0.8000 Min. :40.61 Min. :117.0
## 1st Qu.:0.0002484 1st Qu.:0.8062 1st Qu.:40.92 1st Qu.:132.0
## Median :0.0002982 Median :0.8172 Median :41.48 Median :158.5
## Mean :0.0003097 Mean :0.8212 Mean :41.69 Mean :164.6
## 3rd Qu.:0.0003650 3rd Qu.:0.8303 3rd Qu.:42.14 3rd Qu.:194.0
## Max. :0.0004666 Max. :0.8681 Max. :44.06 Max. :248.0
##
## mining info:
## data ntransactions support confidence
## dadosEstadoFis 531470 0.00022 0.8
Ao tentar gerar regras para o valor “Cavaleiro”, as regras valiam para apenas de 2-4 instâncias. Achamos que regras com essa baixa quantidade de instâncias não contribuiriam para a nossa discussão. Como temos apenas 3 instâncias com “Não Informado” não geramos regras. Acreditamos que esses casos podem ser analisados de outra forma, que não cabem no escopo deste relatório.
Neste tópico utilizamos a função sessionInfo() para documentar o ambiente em que este relatório foi elaborado. Sabemos que diferentes versões de pacotes ou do próprio R podem gerar conflitos, o que inibe a reprodução deste estudo. Buscando facilitar para quem queira reproduzir este estudo, deixamos aqui as informações sobre a sessão utilizada para elaborar o relatório.
## R version 3.6.2 (2019-12-12)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19043)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Portuguese_Brazil.1252 LC_CTYPE=Portuguese_Brazil.1252
## [3] LC_MONETARY=Portuguese_Brazil.1252 LC_NUMERIC=C
## [5] LC_TIME=Portuguese_Brazil.1252
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] lubridate_1.7.4 kableExtra_1.1.0 viridis_0.5.1
## [4] viridisLite_0.3.0 wordcloud_2.6 RColorBrewer_1.1-2
## [7] knitr_1.28 magrittr_1.5 dplyr_0.8.4
## [10] leaflet.extras_1.0.0 sp_1.3-2 leaflet_2.0.3
## [13] plotly_4.9.2 ggplot2_3.3.0 arulesViz_1.3-3
## [16] arules_1.6-4 Matrix_1.2-18 DT_0.13
##
## loaded via a namespace (and not attached):
## [1] bitops_1.0-6 webshot_0.5.2 httr_1.4.1
## [4] tools_3.6.2 R6_2.4.1 KernSmooth_2.23-16
## [7] lazyeval_0.2.2 colorspace_1.4-1 withr_2.1.2
## [10] tidyselect_1.0.0 gridExtra_2.3 compiler_3.6.2
## [13] rvest_0.3.5 TSP_1.1-8 NLP_0.2-0
## [16] xml2_1.2.2 slam_0.1-47 labeling_0.3
## [19] bookdown_0.18 caTools_1.18.0 scales_1.1.0
## [22] tm_0.7-7 lmtest_0.9-37 readr_1.3.1
## [25] stringr_1.4.0 digest_0.6.25 rmarkdown_2.1
## [28] pkgconfig_2.0.3 htmltools_0.4.0 fastmap_1.0.1
## [31] htmlwidgets_1.5.1 rlang_0.4.4 rstudioapi_0.11
## [34] shiny_1.4.0 visNetwork_2.0.9 farver_2.0.3
## [37] zoo_1.8-7 jsonlite_1.6.1 crosstalk_1.0.0
## [40] gtools_3.8.1 dendextend_1.13.3 Rcpp_1.0.3
## [43] munsell_0.5.0 lifecycle_0.1.0 scatterplot3d_0.3-41
## [46] stringi_1.4.4 yaml_2.2.1 MASS_7.3-51.5
## [49] gplots_3.0.1.2 parallel_3.6.2 gdata_2.18.0
## [52] promises_1.1.0 crayon_1.3.4 lattice_0.20-38
## [55] hms_0.5.3 pillar_1.4.3 igraph_1.2.4.2
## [58] codetools_0.2-16 glue_1.3.1 gclus_1.3.2
## [61] evaluate_0.14 data.table_1.12.8 vcd_1.4-5
## [64] vctrs_0.2.2 rmdformats_0.3.7 httpuv_1.5.2
## [67] foreach_1.4.8 gtable_0.3.0 purrr_0.3.3
## [70] tidyr_1.0.2 assertthat_0.2.1 xfun_0.12
## [73] mime_0.9 xtable_1.8-4 later_1.0.0
## [76] seriation_1.2-8 tibble_2.1.3 iterators_1.0.12
## [79] registry_0.5-1 cluster_2.1.0
Nesta ultima sessão, buscamos resumir brevemente as atividades realizadas e os resultados de conhecimento que foram obtidos através delas.
Iniciamos o estudo levantando a origem da base de dados e uma análise introdutória da mesma utilizando a linguagem R. Buscamos compreender algumas informações mais superficiais para poder ter idéias de como começar a análise da base. Resumimos dados sobre a quantidade de linhas e colunas, além de seus valores principais para ter uma noção inicial sobre o propósito de cada atributo, além de identificar valores principais e quantidade de valores ausentes.
Na etapa de análise exploratória foram gerados: gráficos de barras; gráficos de linhas; gráficos de dispersão; gráficos do tipo boxplot (diagrama de caixa); mapas coropléticos; mapas geográficos de calor e mapas de calendário de calor. Todos os gráficos foram apresentados de forma interativa. Após analisar e preparar os atributos, o pacote Arules foi utilizado para gerar regras de associações que permitiram identificar perfis de certas características e associar estas características a um conjunto de valores.
Para a análise de sexo masculino: alguns dos valores de lado esquerdo de regra mais observados foram Condutor, Ileso, Acidente com vítimas feridas, Céu Claro, Pleno Dia, Pista Simples em reta; Para o sexo feminino foram observados os valores de lado esquerdo como sendo passageiro, Estado “SC”, Com Lesões Leves, Em veículo do tipo Automóvel.
Para a análise de estado físico Ileso: Condutor, veículo do tipo Automóvel, Solo Rural, Sexo masculino em reta; Para lesões leves observamos os valores tipo de veículo motocicleta, em reta, pista dupla e simples, envolvidos em acidentes de tombamento; Enquanto para lesões graves observamos alguns valores anormais (devido ao baixo suporte necessário) como BR153, Estado “TO”, no município “PARAISO DO TOCATINS” entre o trecho de KM510 a 520; Para Óbito também utilizamos baixo suporte, e obtivemos os valores Pedestre, acidente causado por desobediência as normas de trânsito do pedestre, onde ocorreu atropelamento do mesmo.
Para a análise de tipo de envolvimento como sendo Condutor: Os valores mais observados foram sexo masculino, em céu claro, pleno dia, com estado físico ileso com acidente ocorrendo em reta; Para o passageiro observamos que ocorre com sexo feminino, em pista simples, com lesões leves, uso de solo urbano, em automóvel; Para pedestre o tipo de acidente foi atropelamento de pedestre, causado por falta de atenção do mesmo, com lesões graves ou óbito, em reta; Para testemunha foi identificado uma alta ocorrência de valores não identificados, como sexo, estado físico e faixa etária, além de ocorre no estado de “MG” em pleno dia com tipo de veículo motocicleta. Regras para tipo cavaleiro não foram geradas devido a baixa quantidade de instâncias.
Nas três análises existe também o valor “Não Informado”, e o perfil identificado no geral foi o mesmo: Quando um dos valores de sexo, faixa etária e estado físico não são informados, os outros dois também não são.
Este relatório, escrito em documento R-Markdown, foi disponibilizado através desta página web, e também no Github dos autores. Foi identificado que a linguagem R, em conjunto com o ambiente e pacotes levantados, agilizam o processo de descoberta de conhecimento em bases de dados. Os pacotes de visualização de dados geram gráficos intuitivos que ajudam a rapidamente conhecer uma base de dados. Os pacotes de manipulação de dados permitem transformar uma base de dados por completa com poucas funções e ajuda a evitar erros nos dados introduzidos por erros na transformação de dados. O pacote que foi utilizado para gerar regras de associações é extremamente intuitivo, e requer pouco pré-processamento para ser utilizada, porém, achamos que a documentação deixou a desejar em algumas informações (por exemplo, como o parâmetro de tempo limite funciona, pois foi necessário ajustar o tamanho máximo de regra para evitar problemas ao exportar os resultados utilizando Knitr). Esta abordagem do processo do KDD (adotando uma linguagem de programação para realizar as etapas) é mais complexa do que utilizar uma plataforma/ferramenta própria para isso mas em troca fornece um controle mais absoluto sobre como o processo é realizado.
Instituto Brasileiro de Geografia e Estatística. 2020. “Geociências - Download.” https://www.ibge.gov.br/geociencias/downloads-geociencias.html.
Michael Hahsler, Christian Buchta, Bettina Gruen, Kurt Hornik, Ian Johnson, Christian Borgelt. 2020. “Package ‘Arules’.” https://cran.r-project.org/web/packages/arules/arules.pdf.
Michael Hahsler, Christian Buchta, Sudheer Chelluboina. 2019. “Package ‘arulesViz’.” https://cran.r-project.org/web/packages/arulesViz/arulesViz.pdf.
Polícia Rodoviária Federal. 2020. “Dados Abertos - Acidentes.” https://portal.prf.gov.br/dados-abertos-acidentes.
Ronald K. Pearson. 2018. Exploratory data analysis using R. Edited by Vipin Kumar. Chapman & Hall/CRC.